1/* 2 * tkCanvPs.c -- 3 * 4 * This module provides Postscript output support for canvases, 5 * including the "postscript" widget command plus a few utility 6 * procedures used for generating Postscript. 7 * 8 * Copyright (c) 1991-1994 The Regents of the University of California. 9 * Copyright (c) 1994-1997 Sun Microsystems, Inc. 10 * 11 * See the file "license.terms" for information on usage and redistribution 12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 * 14 * RCS: @(#) $Id: tkCanvPs.c,v 1.13.2.1 2004/02/23 10:49:29 das Exp $ 15 */ 16 17#include "tkInt.h" 18#include "tkCanvas.h" 19#include "tkPort.h" 20 21/* 22 * See tkCanvas.h for key data structures used to implement canvases. 23 */ 24 25/* 26 * The following definition is used in generating postscript for images 27 * and windows. 28 */ 29 30typedef struct TkColormapData { /* Hold color information for a window */ 31 int separated; /* Whether to use separate color bands */ 32 int color; /* Whether window is color or black/white */ 33 int ncolors; /* Number of color values stored */ 34 XColor *colors; /* Pixel value -> RGB mappings */ 35 int red_mask, green_mask, blue_mask; /* Masks and shifts for each */ 36 int red_shift, green_shift, blue_shift; /* color band */ 37} TkColormapData; 38 39/* 40 * One of the following structures is created to keep track of Postscript 41 * output being generated. It consists mostly of information provided on 42 * the widget command line. 43 */ 44 45typedef struct TkPostscriptInfo { 46 int x, y, width, height; /* Area to print, in canvas pixel 47 * coordinates. */ 48 int x2, y2; /* x+width and y+height. */ 49 char *pageXString; /* String value of "-pagex" option or NULL. */ 50 char *pageYString; /* String value of "-pagey" option or NULL. */ 51 double pageX, pageY; /* Postscript coordinates (in points) 52 * corresponding to pageXString and 53 * pageYString. Don't forget that y-values 54 * grow upwards for Postscript! */ 55 char *pageWidthString; /* Printed width of output. */ 56 char *pageHeightString; /* Printed height of output. */ 57 double scale; /* Scale factor for conversion: each pixel 58 * maps into this many points. */ 59 Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript page. */ 60 int rotate; /* Non-zero means output should be rotated 61 * on page (landscape mode). */ 62 char *fontVar; /* If non-NULL, gives name of global variable 63 * containing font mapping information. 64 * Malloc'ed. */ 65 char *colorVar; /* If non-NULL, give name of global variable 66 * containing color mapping information. 67 * Malloc'ed. */ 68 char *colorMode; /* Mode for handling colors: "monochrome", 69 * "gray", or "color". Malloc'ed. */ 70 int colorLevel; /* Numeric value corresponding to colorMode: 71 * 0 for mono, 1 for gray, 2 for color. */ 72 char *fileName; /* Name of file in which to write Postscript; 73 * NULL means return Postscript info as 74 * result. Malloc'ed. */ 75 char *channelName; /* If -channel is specified, the name of 76 * the channel to use. */ 77 Tcl_Channel chan; /* Open channel corresponding to fileName. */ 78 Tcl_HashTable fontTable; /* Hash table containing names of all font 79 * families used in output. The hash table 80 * values are not used. */ 81 int prepass; /* Non-zero means that we're currently in 82 * the pre-pass that collects font information, 83 * so the Postscript generated isn't 84 * relevant. */ 85 int prolog; /* Non-zero means output should contain 86 the file prolog.ps in the header. */ 87} TkPostscriptInfo; 88 89/* 90 * The table below provides a template that's used to process arguments 91 * to the canvas "postscript" command and fill in TkPostscriptInfo 92 * structures. 93 */ 94 95static Tk_ConfigSpec configSpecs[] = { 96 {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL, 97 "", Tk_Offset(TkPostscriptInfo, colorVar), 0}, 98 {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL, 99 "", Tk_Offset(TkPostscriptInfo, colorMode), 0}, 100 {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL, 101 "", Tk_Offset(TkPostscriptInfo, fileName), 0}, 102 {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL, 103 "", Tk_Offset(TkPostscriptInfo, channelName), 0}, 104 {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL, 105 "", Tk_Offset(TkPostscriptInfo, fontVar), 0}, 106 {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL, 107 "", Tk_Offset(TkPostscriptInfo, height), 0}, 108 {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL, 109 "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0}, 110 {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL, 111 "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0}, 112 {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL, 113 "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0}, 114 {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL, 115 "", Tk_Offset(TkPostscriptInfo, pageXString), 0}, 116 {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL, 117 "", Tk_Offset(TkPostscriptInfo, pageYString), 0}, 118 {TK_CONFIG_BOOLEAN, "-prolog", (char *) NULL, (char *) NULL, 119 "", Tk_Offset(TkPostscriptInfo, prolog), 0}, 120 {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL, 121 "", Tk_Offset(TkPostscriptInfo, rotate), 0}, 122 {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, 123 "", Tk_Offset(TkPostscriptInfo, width), 0}, 124 {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL, 125 "", Tk_Offset(TkPostscriptInfo, x), 0}, 126 {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL, 127 "", Tk_Offset(TkPostscriptInfo, y), 0}, 128 {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, 129 (char *) NULL, 0, 0} 130}; 131 132/* 133 * Forward declarations for procedures defined later in this file: 134 */ 135 136static int GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp, 137 char *string, double *doublePtr)); 138 139/* 140 *-------------------------------------------------------------- 141 * 142 * TkCanvPostscriptCmd -- 143 * 144 * This procedure is invoked to process the "postscript" options 145 * of the widget command for canvas widgets. See the user 146 * documentation for details on what it does. 147 * 148 * Results: 149 * A standard Tcl result. 150 * 151 * Side effects: 152 * See the user documentation. 153 * 154 *-------------------------------------------------------------- 155 */ 156 157 /* ARGSUSED */ 158int 159TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) 160 TkCanvas *canvasPtr; /* Information about canvas widget. */ 161 Tcl_Interp *interp; /* Current interpreter. */ 162 int argc; /* Number of arguments. */ 163 CONST char **argv; /* Argument strings. Caller has 164 * already parsed this command enough 165 * to know that argv[1] is 166 * "postscript". */ 167{ 168 TkPostscriptInfo psInfo; 169 Tk_PostscriptInfo oldInfoPtr; 170 int result; 171 Tk_Item *itemPtr; 172#define STRING_LENGTH 400 173 char string[STRING_LENGTH+1]; 174 CONST char *p; 175 time_t now; 176 size_t length; 177 Tk_Window tkwin = canvasPtr->tkwin; 178 int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of 179 * area to be marked up, measured 180 * in canvas units from the positioning 181 * point on the page (reflects 182 * anchor position). Initial values 183 * needed only to stop compiler 184 * warnings. */ 185 Tcl_HashSearch search; 186 Tcl_HashEntry *hPtr; 187 Tcl_DString buffer; 188 char psenccmd[]="::tk::ensure_psenc_is_loaded"; 189 190 /* 191 *---------------------------------------------------------------- 192 * Initialize the data structure describing Postscript generation, 193 * then process all the arguments to fill the data structure in. 194 *---------------------------------------------------------------- 195 */ 196 result = Tcl_EvalEx(interp,psenccmd,-1,TCL_EVAL_GLOBAL); 197 if (result != TCL_OK) { 198 return result; 199 } 200 oldInfoPtr = canvasPtr->psInfo; 201 canvasPtr->psInfo = (Tk_PostscriptInfo) &psInfo; 202 psInfo.x = canvasPtr->xOrigin; 203 psInfo.y = canvasPtr->yOrigin; 204 psInfo.width = -1; 205 psInfo.height = -1; 206 psInfo.pageXString = NULL; 207 psInfo.pageYString = NULL; 208 psInfo.pageX = 72*4.25; 209 psInfo.pageY = 72*5.5; 210 psInfo.pageWidthString = NULL; 211 psInfo.pageHeightString = NULL; 212 psInfo.scale = 1.0; 213 psInfo.pageAnchor = TK_ANCHOR_CENTER; 214 psInfo.rotate = 0; 215 psInfo.fontVar = NULL; 216 psInfo.colorVar = NULL; 217 psInfo.colorMode = NULL; 218 psInfo.colorLevel = 0; 219 psInfo.fileName = NULL; 220 psInfo.channelName = NULL; 221 psInfo.chan = NULL; 222 psInfo.prepass = 0; 223 psInfo.prolog = 1; 224 Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS); 225 result = Tk_ConfigureWidget(interp, tkwin, 226 configSpecs, argc-2, argv+2, (char *) &psInfo, 227 TK_CONFIG_ARGV_ONLY); 228 if (result != TCL_OK) { 229 goto cleanup; 230 } 231 232 if (psInfo.width == -1) { 233 psInfo.width = Tk_Width(tkwin); 234 } 235 if (psInfo.height == -1) { 236 psInfo.height = Tk_Height(tkwin); 237 } 238 psInfo.x2 = psInfo.x + psInfo.width; 239 psInfo.y2 = psInfo.y + psInfo.height; 240 241 if (psInfo.pageXString != NULL) { 242 if (GetPostscriptPoints(interp, psInfo.pageXString, 243 &psInfo.pageX) != TCL_OK) { 244 goto cleanup; 245 } 246 } 247 if (psInfo.pageYString != NULL) { 248 if (GetPostscriptPoints(interp, psInfo.pageYString, 249 &psInfo.pageY) != TCL_OK) { 250 goto cleanup; 251 } 252 } 253 if (psInfo.pageWidthString != NULL) { 254 if (GetPostscriptPoints(interp, psInfo.pageWidthString, 255 &psInfo.scale) != TCL_OK) { 256 goto cleanup; 257 } 258 psInfo.scale /= psInfo.width; 259 } else if (psInfo.pageHeightString != NULL) { 260 if (GetPostscriptPoints(interp, psInfo.pageHeightString, 261 &psInfo.scale) != TCL_OK) { 262 goto cleanup; 263 } 264 psInfo.scale /= psInfo.height; 265 } else { 266 psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(tkwin)); 267 psInfo.scale /= WidthOfScreen(Tk_Screen(tkwin)); 268 } 269 switch (psInfo.pageAnchor) { 270 case TK_ANCHOR_NW: 271 case TK_ANCHOR_W: 272 case TK_ANCHOR_SW: 273 deltaX = 0; 274 break; 275 case TK_ANCHOR_N: 276 case TK_ANCHOR_CENTER: 277 case TK_ANCHOR_S: 278 deltaX = -psInfo.width/2; 279 break; 280 case TK_ANCHOR_NE: 281 case TK_ANCHOR_E: 282 case TK_ANCHOR_SE: 283 deltaX = -psInfo.width; 284 break; 285 } 286 switch (psInfo.pageAnchor) { 287 case TK_ANCHOR_NW: 288 case TK_ANCHOR_N: 289 case TK_ANCHOR_NE: 290 deltaY = - psInfo.height; 291 break; 292 case TK_ANCHOR_W: 293 case TK_ANCHOR_CENTER: 294 case TK_ANCHOR_E: 295 deltaY = -psInfo.height/2; 296 break; 297 case TK_ANCHOR_SW: 298 case TK_ANCHOR_S: 299 case TK_ANCHOR_SE: 300 deltaY = 0; 301 break; 302 } 303 304 if (psInfo.colorMode == NULL) { 305 psInfo.colorLevel = 2; 306 } else { 307 length = strlen(psInfo.colorMode); 308 if (strncmp(psInfo.colorMode, "monochrome", length) == 0) { 309 psInfo.colorLevel = 0; 310 } else if (strncmp(psInfo.colorMode, "gray", length) == 0) { 311 psInfo.colorLevel = 1; 312 } else if (strncmp(psInfo.colorMode, "color", length) == 0) { 313 psInfo.colorLevel = 2; 314 } else { 315 Tcl_AppendResult(interp, "bad color mode \"", 316 psInfo.colorMode, "\": must be monochrome, ", 317 "gray, or color", (char *) NULL); 318 goto cleanup; 319 } 320 } 321 322 if (psInfo.fileName != NULL) { 323 324 /* 325 * Check that -file and -channel are not both specified. 326 */ 327 328 if (psInfo.channelName != NULL) { 329 Tcl_AppendResult(interp, "can't specify both -file", 330 " and -channel", (char *) NULL); 331 result = TCL_ERROR; 332 goto cleanup; 333 } 334 335 /* 336 * Check that we are not in a safe interpreter. If we are, disallow 337 * the -file specification. 338 */ 339 340 if (Tcl_IsSafe(interp)) { 341 Tcl_AppendResult(interp, "can't specify -file in a", 342 " safe interpreter", (char *) NULL); 343 result = TCL_ERROR; 344 goto cleanup; 345 } 346 347 p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer); 348 if (p == NULL) { 349 goto cleanup; 350 } 351 psInfo.chan = Tcl_OpenFileChannel(interp, p, "w", 0666); 352 Tcl_DStringFree(&buffer); 353 if (psInfo.chan == NULL) { 354 goto cleanup; 355 } 356 } 357 358 if (psInfo.channelName != NULL) { 359 int mode; 360 361 /* 362 * Check that the channel is found in this interpreter and that it 363 * is open for writing. 364 */ 365 366 psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName, 367 &mode); 368 if (psInfo.chan == (Tcl_Channel) NULL) { 369 result = TCL_ERROR; 370 goto cleanup; 371 } 372 if ((mode & TCL_WRITABLE) == 0) { 373 Tcl_AppendResult(interp, "channel \"", 374 psInfo.channelName, "\" wasn't opened for writing", 375 (char *) NULL); 376 result = TCL_ERROR; 377 goto cleanup; 378 } 379 } 380 381 /* 382 *-------------------------------------------------------- 383 * Make a pre-pass over all of the items, generating Postscript 384 * and then throwing it away. The purpose of this pass is just 385 * to collect information about all the fonts in use, so that 386 * we can output font information in the proper form required 387 * by the Document Structuring Conventions. 388 *-------------------------------------------------------- 389 */ 390 391 psInfo.prepass = 1; 392 for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; 393 itemPtr = itemPtr->nextPtr) { 394 if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x) 395 || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) { 396 continue; 397 } 398 if (itemPtr->typePtr->postscriptProc == NULL) { 399 continue; 400 } 401 result = (*itemPtr->typePtr->postscriptProc)(interp, 402 (Tk_Canvas) canvasPtr, itemPtr, 1); 403 Tcl_ResetResult(interp); 404 if (result != TCL_OK) { 405 /* 406 * An error just occurred. Just skip out of this loop. 407 * There's no need to report the error now; it can be 408 * reported later (errors can happen later that don't 409 * happen now, so we still have to check for errors later 410 * anyway). 411 */ 412 break; 413 } 414 } 415 psInfo.prepass = 0; 416 417 /* 418 *-------------------------------------------------------- 419 * Generate the header and prolog for the Postscript. 420 *-------------------------------------------------------- 421 */ 422 423 if (psInfo.prolog) { 424 Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n", 425 "%%Creator: Tk Canvas Widget\n", (char *) NULL); 426#ifdef HAVE_PW_GECOS 427 if (!Tcl_IsSafe(interp)) { 428 struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ 429 Tcl_AppendResult(interp, "%%For: ", 430 (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n", 431 (char *) NULL); 432 endpwent(); 433 } 434#endif /* HAVE_PW_GECOS */ 435 Tcl_AppendResult(interp, "%%Title: Window ", 436 Tk_PathName(tkwin), "\n", (char *) NULL); 437 time(&now); 438 Tcl_AppendResult(interp, "%%CreationDate: ", 439 ctime(&now), (char *) NULL); /* INTL: Native. */ 440 if (!psInfo.rotate) { 441 sprintf(string, "%d %d %d %d", 442 (int) (psInfo.pageX + psInfo.scale*deltaX), 443 (int) (psInfo.pageY + psInfo.scale*deltaY), 444 (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width) 445 + 1.0), 446 (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height) 447 + 1.0)); 448 } else { 449 sprintf(string, "%d %d %d %d", 450 (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)), 451 (int) (psInfo.pageY + psInfo.scale*deltaX), 452 (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0), 453 (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width) 454 + 1.0)); 455 } 456 Tcl_AppendResult(interp, "%%BoundingBox: ", string, 457 "\n", (char *) NULL); 458 Tcl_AppendResult(interp, "%%Pages: 1\n", 459 "%%DocumentData: Clean7Bit\n", (char *) NULL); 460 Tcl_AppendResult(interp, "%%Orientation: ", 461 psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL); 462 p = "%%DocumentNeededResources: font "; 463 for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); 464 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { 465 Tcl_AppendResult(interp, p, 466 Tcl_GetHashKey(&psInfo.fontTable, hPtr), 467 "\n", (char *) NULL); 468 p = "%%+ font "; 469 } 470 Tcl_AppendResult(interp, "%%EndComments\n\n", (char *) NULL); 471 472 /* 473 * Insert the prolog 474 */ 475 Tcl_AppendResult(interp, Tcl_GetVar(interp,"::tk::ps_preamable", 476 TCL_GLOBAL_ONLY), (char *) NULL); 477 478 if (psInfo.chan != NULL) { 479 Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); 480 Tcl_ResetResult(canvasPtr->interp); 481 } 482 483 /* 484 *----------------------------------------------------------- 485 * Document setup: set the color level and include fonts. 486 *----------------------------------------------------------- 487 */ 488 489 sprintf(string, "/CL %d def\n", psInfo.colorLevel); 490 Tcl_AppendResult(interp, "%%BeginSetup\n", string, 491 (char *) NULL); 492 for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); 493 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { 494 Tcl_AppendResult(interp, "%%IncludeResource: font ", 495 Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL); 496 } 497 Tcl_AppendResult(interp, "%%EndSetup\n\n", (char *) NULL); 498 499 /* 500 *----------------------------------------------------------- 501 * Page setup: move to page positioning point, rotate if 502 * needed, set scale factor, offset for proper anchor position, 503 * and set clip region. 504 *----------------------------------------------------------- 505 */ 506 507 Tcl_AppendResult(interp, "%%Page: 1 1\n", "save\n", 508 (char *) NULL); 509 sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); 510 Tcl_AppendResult(interp, string, (char *) NULL); 511 if (psInfo.rotate) { 512 Tcl_AppendResult(interp, "90 rotate\n", (char *) NULL); 513 } 514 sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); 515 Tcl_AppendResult(interp, string, (char *) NULL); 516 sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY); 517 Tcl_AppendResult(interp, string, (char *) NULL); 518 sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g", 519 psInfo.x, 520 Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo), 521 psInfo.x2, 522 Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo), 523 psInfo.x2, 524 Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo), 525 psInfo.x, 526 Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo)); 527 Tcl_AppendResult(interp, string, 528 " lineto closepath clip newpath\n", (char *) NULL); 529 } 530 if (psInfo.chan != NULL) { 531 Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); 532 Tcl_ResetResult(canvasPtr->interp); 533 } 534 535 /* 536 *--------------------------------------------------------------------- 537 * Iterate through all the items, having each relevant one draw itself. 538 * Quit if any of the items returns an error. 539 *--------------------------------------------------------------------- 540 */ 541 542 result = TCL_OK; 543 for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; 544 itemPtr = itemPtr->nextPtr) { 545 if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x) 546 || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) { 547 continue; 548 } 549 if (itemPtr->typePtr->postscriptProc == NULL) { 550 continue; 551 } 552 if (itemPtr->state == TK_STATE_HIDDEN) { 553 continue; 554 } 555 Tcl_AppendResult(interp, "gsave\n", (char *) NULL); 556 result = (*itemPtr->typePtr->postscriptProc)(interp, 557 (Tk_Canvas) canvasPtr, itemPtr, 0); 558 if (result != TCL_OK) { 559 char msg[64 + TCL_INTEGER_SPACE]; 560 561 sprintf(msg, "\n (generating Postscript for item %d)", 562 itemPtr->id); 563 Tcl_AddErrorInfo(interp, msg); 564 goto cleanup; 565 } 566 Tcl_AppendResult(interp, "grestore\n", (char *) NULL); 567 if (psInfo.chan != NULL) { 568 Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); 569 Tcl_ResetResult(interp); 570 } 571 } 572 573 /* 574 *--------------------------------------------------------------------- 575 * Output page-end information, such as commands to print the page 576 * and document trailer stuff. 577 *--------------------------------------------------------------------- 578 */ 579 580 if (psInfo.prolog) { 581 Tcl_AppendResult(interp, "restore showpage\n\n", 582 "%%Trailer\nend\n%%EOF\n", (char *) NULL); 583 } 584 if (psInfo.chan != NULL) { 585 Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); 586 Tcl_ResetResult(canvasPtr->interp); 587 } 588 589 /* 590 * Clean up psInfo to release malloc'ed stuff. 591 */ 592 593 cleanup: 594 if (psInfo.pageXString != NULL) { 595 ckfree(psInfo.pageXString); 596 } 597 if (psInfo.pageYString != NULL) { 598 ckfree(psInfo.pageYString); 599 } 600 if (psInfo.pageWidthString != NULL) { 601 ckfree(psInfo.pageWidthString); 602 } 603 if (psInfo.pageHeightString != NULL) { 604 ckfree(psInfo.pageHeightString); 605 } 606 if (psInfo.fontVar != NULL) { 607 ckfree(psInfo.fontVar); 608 } 609 if (psInfo.colorVar != NULL) { 610 ckfree(psInfo.colorVar); 611 } 612 if (psInfo.colorMode != NULL) { 613 ckfree(psInfo.colorMode); 614 } 615 if (psInfo.fileName != NULL) { 616 ckfree(psInfo.fileName); 617 } 618 if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) { 619 Tcl_Close(interp, psInfo.chan); 620 } 621 if (psInfo.channelName != NULL) { 622 ckfree(psInfo.channelName); 623 } 624 Tcl_DeleteHashTable(&psInfo.fontTable); 625 canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr; 626 return result; 627} 628 629/* 630 *-------------------------------------------------------------- 631 * 632 * Tk_PostscriptColor -- 633 * 634 * This procedure is called by individual canvas items when 635 * they want to set a color value for output. Given information 636 * about an X color, this procedure will generate Postscript 637 * commands to set up an appropriate color in Postscript. 638 * 639 * Results: 640 * Returns a standard Tcl return value. If an error occurs 641 * then an error message will be left in the interp's result. 642 * If no error occurs, then additional Postscript will be 643 * appended to the interp's result. 644 * 645 * Side effects: 646 * None. 647 * 648 *-------------------------------------------------------------- 649 */ 650 651int 652Tk_PostscriptColor(interp, psInfo, colorPtr) 653 Tcl_Interp *interp; 654 Tk_PostscriptInfo psInfo; /* Postscript info. */ 655 XColor *colorPtr; /* Information about color. */ 656{ 657 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; 658 int tmp; 659 double red, green, blue; 660 char string[200]; 661 662 if (psInfoPtr->prepass) { 663 return TCL_OK; 664 } 665 666 /* 667 * If there is a color map defined, then look up the color's name 668 * in the map and use the Postscript commands found there, if there 669 * are any. 670 */ 671 672 if (psInfoPtr->colorVar != NULL) { 673 CONST char *cmdString; 674 675 cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, 676 Tk_NameOfColor(colorPtr), 0); 677 if (cmdString != NULL) { 678 Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL); 679 return TCL_OK; 680 } 681 } 682 683 /* 684 * No color map entry for this color. Grab the color's intensities 685 * and output Postscript commands for them. Special note: X uses 686 * a range of 0-65535 for intensities, but most displays only use 687 * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the 688 * X scale. This means that there's no way to get perfect white, 689 * since the highest intensity is only 65280 out of 65535. To 690 * work around this problem, rescale the X intensity to a 0-255 691 * scale and use that as the basis for the Postscript colors. This 692 * scheme still won't work if the display only uses 4 bits per color, 693 * but most diplays use at least 8 bits. 694 */ 695 696 tmp = colorPtr->red; 697 red = ((double) (tmp >> 8))/255.0; 698 tmp = colorPtr->green; 699 green = ((double) (tmp >> 8))/255.0; 700 tmp = colorPtr->blue; 701 blue = ((double) (tmp >> 8))/255.0; 702 sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n", 703 red, green, blue); 704 Tcl_AppendResult(interp, string, (char *) NULL); 705 return TCL_OK; 706} 707 708/* 709 *-------------------------------------------------------------- 710 * 711 * Tk_PostscriptFont -- 712 * 713 * This procedure is called by individual canvas items when 714 * they want to output text. Given information about an X 715 * font, this procedure will generate Postscript commands 716 * to set up an appropriate font in Postscript. 717 * 718 * Results: 719 * Returns a standard Tcl return value. If an error occurs 720 * then an error message will be left in the interp's result. 721 * If no error occurs, then additional Postscript will be 722 * appended to the interp's result. 723 * 724 * Side effects: 725 * The Postscript font name is entered into psInfoPtr->fontTable 726 * if it wasn't already there. 727 * 728 *-------------------------------------------------------------- 729 */ 730 731int 732Tk_PostscriptFont(interp, psInfo, tkfont) 733 Tcl_Interp *interp; 734 Tk_PostscriptInfo psInfo; /* Postscript Info. */ 735 Tk_Font tkfont; /* Information about font in which text 736 * is to be printed. */ 737{ 738 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; 739 char *end; 740 char pointString[TCL_INTEGER_SPACE]; 741 Tcl_DString ds; 742 int i, points; 743 744 /* 745 * First, look up the font's name in the font map, if there is one. 746 * If there is an entry for this font, it consists of a list 747 * containing font name and size. Use this information. 748 */ 749 750 Tcl_DStringInit(&ds); 751 752 if (psInfoPtr->fontVar != NULL) { 753 CONST char *list; 754 int argc; 755 double size; 756 CONST char **argv; 757 CONST char *name; 758 759 name = Tk_NameOfFont(tkfont); 760 list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0); 761 if (list != NULL) { 762 if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) { 763 badMapEntry: 764 Tcl_ResetResult(interp); 765 Tcl_AppendResult(interp, "bad font map entry for \"", name, 766 "\": \"", list, "\"", (char *) NULL); 767 return TCL_ERROR; 768 } 769 if (argc != 2) { 770 goto badMapEntry; 771 } 772 size = strtod(argv[1], &end); 773 if ((size <= 0) || (*end != 0)) { 774 goto badMapEntry; 775 } 776 777 Tcl_DStringAppend(&ds, argv[0], -1); 778 points = (int) size; 779 780 ckfree((char *) argv); 781 goto findfont; 782 } 783 } 784 785 points = Tk_PostscriptFontName(tkfont, &ds); 786 787 findfont: 788 sprintf(pointString, "%d", points); 789 Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ", 790 pointString, " scalefont ", (char *) NULL); 791 if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) { 792 Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL); 793 } 794 Tcl_AppendResult(interp, "setfont\n", (char *) NULL); 795 Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i); 796 Tcl_DStringFree(&ds); 797 798 return TCL_OK; 799} 800 801/* 802 *-------------------------------------------------------------- 803 * 804 * Tk_PostscriptBitmap -- 805 * 806 * This procedure is called to output the contents of a 807 * sub-region of a bitmap in proper image data format for 808 * Postscript (i.e. data between angle brackets, one bit 809 * per pixel). 810 * 811 * Results: 812 * Returns a standard Tcl return value. If an error occurs 813 * then an error message will be left in the interp's result. 814 * If no error occurs, then additional Postscript will be 815 * appended to the interp's result. 816 * 817 * Side effects: 818 * None. 819 * 820 *-------------------------------------------------------------- 821 */ 822 823int 824Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, startX, startY, width, 825 height) 826 Tcl_Interp *interp; 827 Tk_Window tkwin; 828 Tk_PostscriptInfo psInfo; /* Postscript info. */ 829 Pixmap bitmap; /* Bitmap for which to generate 830 * Postscript. */ 831 int startX, startY; /* Coordinates of upper-left corner 832 * of rectangular region to output. */ 833 int width, height; /* Height of rectangular region. */ 834{ 835 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; 836 XImage *imagePtr; 837 int charsInLine, x, y, lastX, lastY, value, mask; 838 unsigned int totalWidth, totalHeight; 839 char string[100]; 840 Window dummyRoot; 841 int dummyX, dummyY; 842 unsigned dummyBorderwidth, dummyDepth; 843 844 if (psInfoPtr->prepass) { 845 return TCL_OK; 846 } 847 848 /* 849 * The following call should probably be a call to Tk_SizeOfBitmap 850 * instead, but it seems that we are occasionally invoked by custom 851 * item types that create their own bitmaps without registering them 852 * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but 853 * it shouldn't matter here. 854 */ 855 856 XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot, 857 (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth, 858 (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth); 859 imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0, 860 totalWidth, totalHeight, 1, XYPixmap); 861 Tcl_AppendResult(interp, "<", (char *) NULL); 862 mask = 0x80; 863 value = 0; 864 charsInLine = 0; 865 lastX = startX + width - 1; 866 lastY = startY + height - 1; 867 for (y = lastY; y >= startY; y--) { 868 for (x = startX; x <= lastX; x++) { 869 if (XGetPixel(imagePtr, x, y)) { 870 value |= mask; 871 } 872 mask >>= 1; 873 if (mask == 0) { 874 sprintf(string, "%02x", value); 875 Tcl_AppendResult(interp, string, (char *) NULL); 876 mask = 0x80; 877 value = 0; 878 charsInLine += 2; 879 if (charsInLine >= 60) { 880 Tcl_AppendResult(interp, "\n", (char *) NULL); 881 charsInLine = 0; 882 } 883 } 884 } 885 if (mask != 0x80) { 886 sprintf(string, "%02x", value); 887 Tcl_AppendResult(interp, string, (char *) NULL); 888 mask = 0x80; 889 value = 0; 890 charsInLine += 2; 891 } 892 } 893 Tcl_AppendResult(interp, ">", (char *) NULL); 894 XDestroyImage(imagePtr); 895 return TCL_OK; 896} 897 898/* 899 *-------------------------------------------------------------- 900 * 901 * Tk_PostscriptStipple -- 902 * 903 * This procedure is called by individual canvas items when 904 * they have created a path that they'd like to be filled with 905 * a stipple pattern. Given information about an X bitmap, 906 * this procedure will generate Postscript commands to fill 907 * the current clip region using a stipple pattern defined by the 908 * bitmap. 909 * 910 * Results: 911 * Returns a standard Tcl return value. If an error occurs 912 * then an error message will be left in the interp's result. 913 * If no error occurs, then additional Postscript will be 914 * appended to the interp's result. 915 * 916 * Side effects: 917 * None. 918 * 919 *-------------------------------------------------------------- 920 */ 921 922int 923Tk_PostscriptStipple(interp, tkwin, psInfo, bitmap) 924 Tcl_Interp *interp; 925 Tk_Window tkwin; 926 Tk_PostscriptInfo psInfo; /* Interpreter for returning Postscript 927 * or error message. */ 928 Pixmap bitmap; /* Bitmap to use for stippling. */ 929{ 930 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; 931 int width, height; 932 char string[TCL_INTEGER_SPACE * 2]; 933 Window dummyRoot; 934 int dummyX, dummyY; 935 unsigned dummyBorderwidth, dummyDepth; 936 937 if (psInfoPtr->prepass) { 938 return TCL_OK; 939 } 940 941 /* 942 * The following call should probably be a call to Tk_SizeOfBitmap 943 * instead, but it seems that we are occasionally invoked by custom 944 * item types that create their own bitmaps without registering them 945 * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but 946 * it shouldn't matter here. 947 */ 948 949 XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot, 950 (int *) &dummyX, (int *) &dummyY, (unsigned *) &width, 951 (unsigned *) &height, &dummyBorderwidth, &dummyDepth); 952 sprintf(string, "%d %d ", width, height); 953 Tcl_AppendResult(interp, string, (char *) NULL); 954 if (Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0, 955 width, height) != TCL_OK) { 956 return TCL_ERROR; 957 } 958 Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL); 959 return TCL_OK; 960} 961 962/* 963 *-------------------------------------------------------------- 964 * 965 * Tk_PostscriptY -- 966 * 967 * Given a y-coordinate in local coordinates, this procedure 968 * returns a y-coordinate to use for Postscript output. 969 * 970 * Results: 971 * Returns the Postscript coordinate that corresponds to 972 * "y". 973 * 974 * Side effects: 975 * None. 976 * 977 *-------------------------------------------------------------- 978 */ 979 980double 981Tk_PostscriptY(y, psInfo) 982 double y; /* Y-coordinate in canvas coords. */ 983 Tk_PostscriptInfo psInfo; /* Postscript info */ 984{ 985 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; 986 987 return psInfoPtr->y2 - y; 988} 989 990/* 991 *-------------------------------------------------------------- 992 * 993 * Tk_PostscriptPath -- 994 * 995 * Given an array of points for a path, generate Postscript 996 * commands to create the path. 997 * 998 * Results: 999 * Postscript commands get appended to what's in the interp's result. 1000 * 1001 * Side effects: 1002 * None. 1003 * 1004 *-------------------------------------------------------------- 1005 */ 1006 1007void 1008Tk_PostscriptPath(interp, psInfo, coordPtr, numPoints) 1009 Tcl_Interp *interp; 1010 Tk_PostscriptInfo psInfo; /* Canvas on whose behalf Postscript 1011 * is being generated. */ 1012 double *coordPtr; /* Pointer to first in array of 1013 * 2*numPoints coordinates giving 1014 * points for path. */ 1015 int numPoints; /* Number of points at *coordPtr. */ 1016{ 1017 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; 1018 char buffer[200]; 1019 1020 if (psInfoPtr->prepass) { 1021 return; 1022 } 1023 sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0], 1024 Tk_PostscriptY(coordPtr[1], psInfo)); 1025 Tcl_AppendResult(interp, buffer, (char *) NULL); 1026 for (numPoints--, coordPtr += 2; numPoints > 0; 1027 numPoints--, coordPtr += 2) { 1028 sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0], 1029 Tk_PostscriptY(coordPtr[1], psInfo)); 1030 Tcl_AppendResult(interp, buffer, (char *) NULL); 1031 } 1032} 1033 1034/* 1035 *-------------------------------------------------------------- 1036 * 1037 * GetPostscriptPoints -- 1038 * 1039 * Given a string, returns the number of Postscript points 1040 * corresponding to that string. 1041 * 1042 * Results: 1043 * The return value is a standard Tcl return result. If 1044 * TCL_OK is returned, then everything went well and the 1045 * screen distance is stored at *doublePtr; otherwise 1046 * TCL_ERROR is returned and an error message is left in 1047 * the interp's result. 1048 * 1049 * Side effects: 1050 * None. 1051 * 1052 *-------------------------------------------------------------- 1053 */ 1054 1055static int 1056GetPostscriptPoints(interp, string, doublePtr) 1057 Tcl_Interp *interp; /* Use this for error reporting. */ 1058 char *string; /* String describing a screen distance. */ 1059 double *doublePtr; /* Place to store converted result. */ 1060{ 1061 char *end; 1062 double d; 1063 1064 d = strtod(string, &end); 1065 if (end == string) { 1066 error: 1067 Tcl_AppendResult(interp, "bad distance \"", string, 1068 "\"", (char *) NULL); 1069 return TCL_ERROR; 1070 } 1071 while ((*end != '\0') && isspace(UCHAR(*end))) { 1072 end++; 1073 } 1074 switch (*end) { 1075 case 'c': 1076 d *= 72.0/2.54; 1077 end++; 1078 break; 1079 case 'i': 1080 d *= 72.0; 1081 end++; 1082 break; 1083 case 'm': 1084 d *= 72.0/25.4; 1085 end++; 1086 break; 1087 case 0: 1088 break; 1089 case 'p': 1090 end++; 1091 break; 1092 default: 1093 goto error; 1094 } 1095 while ((*end != '\0') && isspace(UCHAR(*end))) { 1096 end++; 1097 } 1098 if (*end != 0) { 1099 goto error; 1100 } 1101 *doublePtr = d; 1102 return TCL_OK; 1103} 1104 1105/* 1106 *-------------------------------------------------------------- 1107 * 1108 * TkImageGetColor -- 1109 * 1110 * This procedure converts a pixel value to three floating 1111 * point numbers, representing the amount of red, green, and 1112 * blue in that pixel on the screen. It makes use of colormap 1113 * data passed as an argument, and should work for all Visual 1114 * types. 1115 * 1116 * This implementation is bogus on Windows because the colormap 1117 * data is never filled in. Instead all postscript generated 1118 * data coming through here is expected to be RGB color data. 1119 * To handle lower bit-depth images properly, XQueryColors 1120 * must be implemented for Windows. 1121 * 1122 * Results: 1123 * Returns red, green, and blue color values in the range 1124 * 0 to 1. There are no error returns. 1125 * 1126 * Side effects: 1127 * None. 1128 * 1129 *-------------------------------------------------------------- 1130 */ 1131#ifdef WIN32 1132#include <windows.h> 1133 1134/* 1135 * We could just define these instead of pulling in windows.h. 1136 #define GetRValue(rgb) ((BYTE)(rgb)) 1137 #define GetGValue(rgb) ((BYTE)(((WORD)(rgb)) >> 8)) 1138 #define GetBValue(rgb) ((BYTE)((rgb)>>16)) 1139*/ 1140#else 1141#define GetRValue(rgb) ((rgb & cdata->red_mask) >> cdata->red_shift) 1142#define GetGValue(rgb) ((rgb & cdata->green_mask) >> cdata->green_shift) 1143#define GetBValue(rgb) ((rgb & cdata->blue_mask) >> cdata->blue_shift) 1144#endif 1145 1146#if defined(WIN32) || defined(MAC_OSX_TK) 1147static void 1148TkImageGetColor(cdata, pixel, red, green, blue) 1149 TkColormapData *cdata; /* Colormap data */ 1150 unsigned long pixel; /* Pixel value to look up */ 1151 double *red, *green, *blue; /* Color data to return */ 1152{ 1153 *red = (double) GetRValue(pixel) / 255.0; 1154 *green = (double) GetGValue(pixel) / 255.0; 1155 *blue = (double) GetBValue(pixel) / 255.0; 1156} 1157#else 1158static void 1159TkImageGetColor(cdata, pixel, red, green, blue) 1160 TkColormapData *cdata; /* Colormap data */ 1161 unsigned long pixel; /* Pixel value to look up */ 1162 double *red, *green, *blue; /* Color data to return */ 1163{ 1164 if (cdata->separated) { 1165 int r = GetRValue(pixel); 1166 int g = GetGValue(pixel); 1167 int b = GetBValue(pixel); 1168 *red = cdata->colors[r].red / 65535.0; 1169 *green = cdata->colors[g].green / 65535.0; 1170 *blue = cdata->colors[b].blue / 65535.0; 1171 } else { 1172 *red = cdata->colors[pixel].red / 65535.0; 1173 *green = cdata->colors[pixel].green / 65535.0; 1174 *blue = cdata->colors[pixel].blue / 65535.0; 1175 } 1176} 1177#endif 1178 1179/* 1180 *-------------------------------------------------------------- 1181 * 1182 * TkPostscriptImage -- 1183 * 1184 * This procedure is called to output the contents of an 1185 * image in Postscript, using a format appropriate for the 1186 * current color mode (i.e. one bit per pixel in monochrome, 1187 * one byte per pixel in gray, and three bytes per pixel in 1188 * color). 1189 * 1190 * Results: 1191 * Returns a standard Tcl return value. If an error occurs 1192 * then an error message will be left in interp->result. 1193 * If no error occurs, then additional Postscript will be 1194 * appended to interp->result. 1195 * 1196 * Side effects: 1197 * None. 1198 * 1199 *-------------------------------------------------------------- 1200 */ 1201 1202int 1203TkPostscriptImage(interp, tkwin, psInfo, ximage, x, y, width, height) 1204 Tcl_Interp *interp; 1205 Tk_Window tkwin; 1206 Tk_PostscriptInfo psInfo; /* postscript info */ 1207 XImage *ximage; /* Image to draw */ 1208 int x, y; /* First pixel to output */ 1209 int width, height; /* Width and height of area */ 1210{ 1211 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; 1212 char buffer[256]; 1213 int xx, yy, band, maxRows; 1214 double red, green, blue; 1215 int bytesPerLine=0, maxWidth=0; 1216 int level = psInfoPtr->colorLevel; 1217 Colormap cmap; 1218 int i, ncolors; 1219 Visual *visual; 1220 TkColormapData cdata; 1221 1222 if (psInfoPtr->prepass) { 1223 return TCL_OK; 1224 } 1225 1226 cmap = Tk_Colormap(tkwin); 1227 visual = Tk_Visual(tkwin); 1228 1229 /* 1230 * Obtain information about the colormap, ie the mapping between 1231 * pixel values and RGB values. The code below should work 1232 * for all Visual types. 1233 */ 1234 1235 ncolors = visual->map_entries; 1236 cdata.colors = (XColor *) ckalloc(sizeof(XColor) * ncolors); 1237 cdata.ncolors = ncolors; 1238 1239 if (visual->class == DirectColor || visual->class == TrueColor) { 1240 cdata.separated = 1; 1241 cdata.red_mask = visual->red_mask; 1242 cdata.green_mask = visual->green_mask; 1243 cdata.blue_mask = visual->blue_mask; 1244 cdata.red_shift = 0; 1245 cdata.green_shift = 0; 1246 cdata.blue_shift = 0; 1247 while ((0x0001 & (cdata.red_mask >> cdata.red_shift)) == 0) 1248 cdata.red_shift ++; 1249 while ((0x0001 & (cdata.green_mask >> cdata.green_shift)) == 0) 1250 cdata.green_shift ++; 1251 while ((0x0001 & (cdata.blue_mask >> cdata.blue_shift)) == 0) 1252 cdata.blue_shift ++; 1253 for (i = 0; i < ncolors; i ++) 1254 cdata.colors[i].pixel = 1255 ((i << cdata.red_shift) & cdata.red_mask) | 1256 ((i << cdata.green_shift) & cdata.green_mask) | 1257 ((i << cdata.blue_shift) & cdata.blue_mask); 1258 } else { 1259 cdata.separated=0; 1260 for (i = 0; i < ncolors; i ++) 1261 cdata.colors[i].pixel = i; 1262 } 1263 if (visual->class == StaticGray || visual->class == GrayScale) 1264 cdata.color = 0; 1265 else 1266 cdata.color = 1; 1267 1268 XQueryColors(Tk_Display(tkwin), cmap, cdata.colors, ncolors); 1269 1270 /* 1271 * Figure out which color level to use (possibly lower than the 1272 * one specified by the user). For example, if the user specifies 1273 * color with monochrome screen, use gray or monochrome mode instead. 1274 */ 1275 1276 if (!cdata.color && level == 2) { 1277 level = 1; 1278 } 1279 1280 if (!cdata.color && cdata.ncolors == 2) { 1281 level = 0; 1282 } 1283 1284 /* 1285 * Check that at least one row of the image can be represented 1286 * with a string less than 64 KB long (this is a limit in the 1287 * Postscript interpreter). 1288 */ 1289 1290 switch (level) { 1291 case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break; 1292 case 1: bytesPerLine = width; maxWidth = 60000; break; 1293 case 2: bytesPerLine = 3 * width; maxWidth = 20000; break; 1294 } 1295 1296 if (bytesPerLine > 60000) { 1297 Tcl_ResetResult(interp); 1298 sprintf(buffer, 1299 "Can't generate Postscript for images more than %d pixels wide", 1300 maxWidth); 1301 Tcl_AppendResult(interp, buffer, (char *) NULL); 1302 ckfree((char *) cdata.colors); 1303 return TCL_ERROR; 1304 } 1305 1306 maxRows = 60000 / bytesPerLine; 1307 1308 for (band = height-1; band >= 0; band -= maxRows) { 1309 int rows = (band >= maxRows) ? maxRows : band + 1; 1310 int lineLen = 0; 1311 switch (level) { 1312 case 0: 1313 sprintf(buffer, "%d %d 1 matrix {\n<", width, rows); 1314 Tcl_AppendResult(interp, buffer, (char *) NULL); 1315 break; 1316 case 1: 1317 sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); 1318 Tcl_AppendResult(interp, buffer, (char *) NULL); 1319 break; 1320 case 2: 1321 sprintf(buffer, "%d %d 8 matrix {\n<", 1322 width, rows); 1323 Tcl_AppendResult(interp, buffer, (char *) NULL); 1324 break; 1325 } 1326 for (yy = band; yy > band - rows; yy--) { 1327 switch (level) { 1328 case 0: { 1329 /* 1330 * Generate data for image in monochrome mode. 1331 * No attempt at dithering is made--instead, just 1332 * set a threshold. 1333 */ 1334 unsigned char mask=0x80; 1335 unsigned char data=0x00; 1336 for (xx = x; xx< x+width; xx++) { 1337 TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), 1338 &red, &green, &blue); 1339 if (0.30 * red + 0.59 * green + 0.11 * blue > 0.5) 1340 data |= mask; 1341 mask >>= 1; 1342 if (mask == 0) { 1343 sprintf(buffer, "%02X", data); 1344 Tcl_AppendResult(interp, buffer, (char *) NULL); 1345 lineLen += 2; 1346 if (lineLen > 60) { 1347 lineLen = 0; 1348 Tcl_AppendResult(interp, "\n", (char *) NULL); 1349 } 1350 mask=0x80; 1351 data=0x00; 1352 } 1353 } 1354 if ((width % 8) != 0) { 1355 sprintf(buffer, "%02X", data); 1356 Tcl_AppendResult(interp, buffer, (char *) NULL); 1357 mask=0x80; 1358 data=0x00; 1359 } 1360 break; 1361 } 1362 case 1: { 1363 /* 1364 * Generate data in gray mode--in this case, take a 1365 * weighted sum of the red, green, and blue values. 1366 */ 1367 for (xx = x; xx < x+width; xx ++) { 1368 TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), 1369 &red, &green, &blue); 1370 sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 * 1371 (0.30 * red + 0.59 * green + 0.11 * blue))); 1372 Tcl_AppendResult(interp, buffer, (char *) NULL); 1373 lineLen += 2; 1374 if (lineLen > 60) { 1375 lineLen = 0; 1376 Tcl_AppendResult(interp, "\n", (char *) NULL); 1377 } 1378 } 1379 break; 1380 } 1381 case 2: { 1382 /* 1383 * Finally, color mode. Here, just output the red, green, 1384 * and blue values directly. 1385 */ 1386 for (xx = x; xx < x+width; xx++) { 1387 TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), 1388 &red, &green, &blue); 1389 sprintf(buffer, "%02X%02X%02X", 1390 (int) floor(0.5 + 255.0 * red), 1391 (int) floor(0.5 + 255.0 * green), 1392 (int) floor(0.5 + 255.0 * blue)); 1393 Tcl_AppendResult(interp, buffer, (char *) NULL); 1394 lineLen += 6; 1395 if (lineLen > 60) { 1396 lineLen = 0; 1397 Tcl_AppendResult(interp, "\n", (char *) NULL); 1398 } 1399 } 1400 break; 1401 } 1402 } 1403 } 1404 switch (level) { 1405 case 0: sprintf(buffer, ">\n} image\n"); break; 1406 case 1: sprintf(buffer, ">\n} image\n"); break; 1407 case 2: sprintf(buffer, ">\n} false 3 colorimage\n"); break; 1408 } 1409 Tcl_AppendResult(interp, buffer, (char *) NULL); 1410 sprintf(buffer, "0 %d translate\n", rows); 1411 Tcl_AppendResult(interp, buffer, (char *) NULL); 1412 } 1413 ckfree((char *) cdata.colors); 1414 return TCL_OK; 1415} 1416 1417/* 1418 *-------------------------------------------------------------- 1419 * 1420 * Tk_PostscriptPhoto -- 1421 * 1422 * This procedure is called to output the contents of a 1423 * photo image in Postscript, using a format appropriate for 1424 * the requested postscript color mode (i.e. one byte per pixel 1425 * in gray, and three bytes per pixel in color). 1426 * 1427 * Results: 1428 * Returns a standard Tcl return value. If an error occurs 1429 * then an error message will be left in interp->result. 1430 * If no error occurs, then additional Postscript will be 1431 * appended to the interpreter's result. 1432 * 1433 * Side effects: 1434 * None. 1435 * 1436 *-------------------------------------------------------------- 1437 */ 1438int 1439Tk_PostscriptPhoto(interp, blockPtr, psInfo, width, height) 1440 Tcl_Interp *interp; 1441 Tk_PhotoImageBlock *blockPtr; 1442 Tk_PostscriptInfo psInfo; 1443 int width, height; 1444{ 1445 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; 1446 int colorLevel = psInfoPtr->colorLevel; 1447 static int codeIncluded = 0; 1448 1449 unsigned char *pixelPtr; 1450 char buffer[256], cspace[40], decode[40]; 1451 int bpc; 1452 int xx, yy, lineLen; 1453 float red, green, blue; 1454 int alpha; 1455 int bytesPerLine=0, maxWidth=0; 1456 1457 unsigned char opaque = 255; 1458 unsigned char *alphaPtr; 1459 int alphaOffset, alphaPitch, alphaIncr; 1460 1461 if (psInfoPtr->prepass) { 1462 codeIncluded = 0; 1463 return TCL_OK; 1464 } 1465 1466 /* 1467 * Define the "TkPhoto" function, which is a modified version 1468 * of the original "transparentimage" function posted 1469 * by ian@five-d.com (Ian Kemmish) to comp.lang.postscript. 1470 * For a monochrome colorLevel this is a slightly different 1471 * version that uses the imagemask command instead of image. 1472 */ 1473 1474 if( !codeIncluded && (colorLevel != 0) ) { 1475 /* 1476 * Color and gray-scale code. 1477 */ 1478 1479 codeIncluded = !0; 1480 Tcl_AppendResult( interp, 1481 "/TkPhoto { \n", 1482 " gsave \n", 1483 " 32 dict begin \n", 1484 " /tinteger exch def \n", 1485 " /transparent 1 string def \n", 1486 " transparent 0 tinteger put \n", 1487 " /olddict exch def \n", 1488 " olddict /DataSource get dup type /filetype ne { \n", 1489 " olddict /DataSource 3 -1 roll \n", 1490 " 0 () /SubFileDecode filter put \n", 1491 " } { \n", 1492 " pop \n", 1493 " } ifelse \n", 1494 " /newdict olddict maxlength dict def \n", 1495 " olddict newdict copy pop \n", 1496 " /w newdict /Width get def \n", 1497 " /crpp newdict /Decode get length 2 idiv def \n", 1498 " /str w string def \n", 1499 " /pix w crpp mul string def \n", 1500 " /substrlen 2 w log 2 log div floor exp cvi def \n", 1501 " /substrs [ \n", 1502 " { \n", 1503 " substrlen string \n", 1504 " 0 1 substrlen 1 sub { \n", 1505 " 1 index exch tinteger put \n", 1506 " } for \n", 1507 " /substrlen substrlen 2 idiv def \n", 1508 " substrlen 0 eq {exit} if \n", 1509 " } loop \n", 1510 " ] def \n", 1511 " /h newdict /Height get def \n", 1512 " 1 w div 1 h div matrix scale \n", 1513 " olddict /ImageMatrix get exch matrix concatmatrix \n", 1514 " matrix invertmatrix concat \n", 1515 " newdict /Height 1 put \n", 1516 " newdict /DataSource pix put \n", 1517 " /mat [w 0 0 h 0 0] def \n", 1518 " newdict /ImageMatrix mat put \n", 1519 " 0 1 h 1 sub { \n", 1520 " mat 5 3 -1 roll neg put \n", 1521 " olddict /DataSource get str readstring pop pop \n", 1522 " /tail str def \n", 1523 " /x 0 def \n", 1524 " olddict /DataSource get pix readstring pop pop \n", 1525 " { \n", 1526 " tail transparent search dup /done exch not def \n", 1527 " {exch pop exch pop} if \n", 1528 " /w1 exch length def \n", 1529 " w1 0 ne { \n", 1530 " newdict /DataSource ", 1531 " pix x crpp mul w1 crpp mul getinterval put \n", 1532 " newdict /Width w1 put \n", 1533 " mat 4 x neg put \n", 1534 " /x x w1 add def \n", 1535 " newdict image \n", 1536 " /tail tail w1 tail length w1 sub getinterval def \n", 1537 " } if \n", 1538 " done {exit} if \n", 1539 " tail substrs { \n", 1540 " anchorsearch {pop} if \n", 1541 " } forall \n", 1542 " /tail exch def \n", 1543 " tail length 0 eq {exit} if \n", 1544 " /x w tail length sub def \n", 1545 " } loop \n", 1546 " } for \n", 1547 " end \n", 1548 " grestore \n", 1549 "} bind def \n\n\n", (char *) NULL); 1550 } else if( !codeIncluded && (colorLevel == 0) ) { 1551 /* 1552 * Monochrome-only code 1553 */ 1554 1555 codeIncluded = !0; 1556 Tcl_AppendResult( interp, 1557 "/TkPhoto { \n", 1558 " gsave \n", 1559 " 32 dict begin \n", 1560 " /dummyInteger exch def \n", 1561 " /olddict exch def \n", 1562 " olddict /DataSource get dup type /filetype ne { \n", 1563 " olddict /DataSource 3 -1 roll \n", 1564 " 0 () /SubFileDecode filter put \n", 1565 " } { \n", 1566 " pop \n", 1567 " } ifelse \n", 1568 " /newdict olddict maxlength dict def \n", 1569 " olddict newdict copy pop \n", 1570 " /w newdict /Width get def \n", 1571 " /pix w 7 add 8 idiv string def \n", 1572 " /h newdict /Height get def \n", 1573 " 1 w div 1 h div matrix scale \n", 1574 " olddict /ImageMatrix get exch matrix concatmatrix \n", 1575 " matrix invertmatrix concat \n", 1576 " newdict /Height 1 put \n", 1577 " newdict /DataSource pix put \n", 1578 " /mat [w 0 0 h 0 0] def \n", 1579 " newdict /ImageMatrix mat put \n", 1580 " 0 1 h 1 sub { \n", 1581 " mat 5 3 -1 roll neg put \n", 1582 " 0.000 0.000 0.000 setrgbcolor \n", 1583 " olddict /DataSource get pix readstring pop pop \n", 1584 " newdict /DataSource pix put \n", 1585 " newdict imagemask \n", 1586 " 1.000 1.000 1.000 setrgbcolor \n", 1587 " olddict /DataSource get pix readstring pop pop \n", 1588 " newdict /DataSource pix put \n", 1589 " newdict imagemask \n", 1590 " } for \n", 1591 " end \n", 1592 " grestore \n", 1593 "} bind def \n\n\n", (char *) NULL); 1594 } 1595 1596 /* 1597 * Check that at least one row of the image can be represented 1598 * with a string less than 64 KB long (this is a limit in the 1599 * Postscript interpreter). 1600 */ 1601 1602 switch (colorLevel) 1603 { 1604 case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break; 1605 case 1: bytesPerLine = width; maxWidth = 60000; break; 1606 case 2: bytesPerLine = 3 * width; maxWidth = 20000; break; 1607 } 1608 if (bytesPerLine > 60000) { 1609 Tcl_ResetResult(interp); 1610 sprintf(buffer, 1611 "Can't generate Postscript for images more than %d pixels wide", 1612 maxWidth); 1613 Tcl_AppendResult(interp, buffer, (char *) NULL); 1614 return TCL_ERROR; 1615 } 1616 1617 /* 1618 * Set up the postscript code except for the image-data stream. 1619 */ 1620 1621 switch (colorLevel) { 1622 case 0: 1623 strcpy( cspace, "/DeviceGray"); 1624 strcpy( decode, "[1 0]"); 1625 bpc = 1; 1626 break; 1627 case 1: 1628 strcpy( cspace, "/DeviceGray"); 1629 strcpy( decode, "[0 1]"); 1630 bpc = 8; 1631 break; 1632 default: 1633 strcpy( cspace, "/DeviceRGB"); 1634 strcpy( decode, "[0 1 0 1 0 1]"); 1635 bpc = 8; 1636 break; 1637 } 1638 1639 1640 Tcl_AppendResult(interp, 1641 cspace, " setcolorspace\n\n", (char *) NULL); 1642 1643 sprintf(buffer, 1644 " /Width %d\n /Height %d\n /BitsPerComponent %d\n", 1645 width, height, bpc); 1646 Tcl_AppendResult(interp, 1647 "<<\n /ImageType 1\n", buffer, 1648 " /DataSource currentfile", 1649 " /ASCIIHexDecode filter\n", (char *) NULL); 1650 1651 1652 sprintf(buffer, 1653 " /ImageMatrix [1 0 0 -1 0 %d]\n", height); 1654 Tcl_AppendResult(interp, buffer, 1655 " /Decode ", decode, "\n>>\n1 TkPhoto\n", (char *) NULL); 1656 1657 1658 /* 1659 * Check the PhotoImageBlock information. 1660 * We assume that: 1661 * if pixelSize is 1,2 or 4, the image is R,G,B,A; 1662 * if pixelSize is 3, the image is R,G,B and offset[3] is bogus. 1663 */ 1664 1665 if (blockPtr->pixelSize == 3) { 1666 /* 1667 * No alpha information: the whole image is opaque. 1668 */ 1669 1670 alphaPtr = &opaque; 1671 alphaPitch = alphaIncr = alphaOffset = 0; 1672 } else { 1673 /* 1674 * Set up alpha handling. 1675 */ 1676 1677 alphaPtr = blockPtr->pixelPtr; 1678 alphaPitch = blockPtr->pitch; 1679 alphaIncr = blockPtr->pixelSize; 1680 alphaOffset = blockPtr->offset[3]; 1681 } 1682 1683 1684 for (yy = 0, lineLen=0; yy < height; yy++) { 1685 switch (colorLevel) { 1686 case 0: { 1687 /* 1688 * Generate data for image in monochrome mode. 1689 * No attempt at dithering is made--instead, just 1690 * set a threshold. 1691 * To handle transparecies we need to output two lines: 1692 * one for the black pixels, one for the white ones. 1693 */ 1694 1695 unsigned char mask=0x80; 1696 unsigned char data=0x00; 1697 for (xx = 0; xx< width; xx ++) { 1698 pixelPtr = blockPtr->pixelPtr 1699 + (yy * blockPtr->pitch) 1700 + (xx *blockPtr->pixelSize); 1701 1702 red = pixelPtr[blockPtr->offset[0]]; 1703 green = pixelPtr[blockPtr->offset[1]]; 1704 blue = pixelPtr[blockPtr->offset[2]]; 1705 1706 alpha = *(alphaPtr + (yy * alphaPitch) 1707 + (xx * alphaIncr) + alphaOffset); 1708 1709 /* 1710 * If pixel is less than threshold, then it is black. 1711 */ 1712 1713 if ((alpha != 0) && 1714 ( 0.3086 * red 1715 + 0.6094 * green 1716 + 0.082 * blue < 128)) { 1717 data |= mask; 1718 } 1719 mask >>= 1; 1720 if (mask == 0) { 1721 sprintf(buffer, "%02X", data); 1722 Tcl_AppendResult(interp, buffer, (char *) NULL); 1723 lineLen += 2; 1724 if (lineLen >= 60) { 1725 lineLen = 0; 1726 Tcl_AppendResult(interp, "\n", (char *) NULL); 1727 } 1728 mask=0x80; 1729 data=0x00; 1730 } 1731 } 1732 if ((width % 8) != 0) { 1733 sprintf(buffer, "%02X", data); 1734 Tcl_AppendResult(interp, buffer, (char *) NULL); 1735 mask=0x80; 1736 data=0x00; 1737 } 1738 1739 mask=0x80; 1740 data=0x00; 1741 for (xx = 0; xx< width; xx ++) { 1742 pixelPtr = blockPtr->pixelPtr 1743 + (yy * blockPtr->pitch) 1744 + (xx *blockPtr->pixelSize); 1745 1746 red = pixelPtr[blockPtr->offset[0]]; 1747 green = pixelPtr[blockPtr->offset[1]]; 1748 blue = pixelPtr[blockPtr->offset[2]]; 1749 1750 alpha = *(alphaPtr + (yy * alphaPitch) 1751 + (xx * alphaIncr) + alphaOffset); 1752 1753 /* 1754 * If pixel is greater than threshold, then it is white. 1755 */ 1756 1757 if ((alpha != 0) && 1758 ( 0.3086 * red 1759 + 0.6094 * green 1760 + 0.082 * blue >= 128)) { 1761 data |= mask; 1762 } 1763 mask >>= 1; 1764 if (mask == 0) { 1765 sprintf(buffer, "%02X", data); 1766 Tcl_AppendResult(interp, buffer, (char *) NULL); 1767 lineLen += 2; 1768 if (lineLen >= 60) { 1769 lineLen = 0; 1770 Tcl_AppendResult(interp, "\n", (char *) NULL); 1771 } 1772 mask=0x80; 1773 data=0x00; 1774 } 1775 } 1776 if ((width % 8) != 0) { 1777 sprintf(buffer, "%02X", data); 1778 Tcl_AppendResult(interp, buffer, (char *) NULL); 1779 mask=0x80; 1780 data=0x00; 1781 } 1782 break; 1783 } 1784 case 1: { 1785 /* 1786 * Generate transparency data. 1787 * We must prevent a transparent value of 0 1788 * because of a bug in some HP printers. 1789 */ 1790 1791 for (xx = 0; xx < width; xx ++) { 1792 alpha = *(alphaPtr + (yy * alphaPitch) 1793 + (xx * alphaIncr) + alphaOffset); 1794 sprintf(buffer, "%02X", alpha | 0x01); 1795 Tcl_AppendResult(interp, buffer, (char *) NULL); 1796 lineLen += 2; 1797 if (lineLen >= 60) { 1798 lineLen = 0; 1799 Tcl_AppendResult(interp, "\n", (char *) NULL); 1800 } 1801 } 1802 1803 1804 /* 1805 * Generate data in gray mode--in this case, take a 1806 * weighted sum of the red, green, and blue values. 1807 */ 1808 1809 for (xx = 0; xx < width; xx ++) { 1810 pixelPtr = blockPtr->pixelPtr 1811 + (yy * blockPtr->pitch) 1812 + (xx *blockPtr->pixelSize); 1813 1814 red = pixelPtr[blockPtr->offset[0]]; 1815 green = pixelPtr[blockPtr->offset[1]]; 1816 blue = pixelPtr[blockPtr->offset[2]]; 1817 1818 sprintf(buffer, "%02X", (int) floor(0.5 + 1819 ( 0.3086 * red + 0.6094 * green + 0.0820 * blue))); 1820 Tcl_AppendResult(interp, buffer, (char *) NULL); 1821 lineLen += 2; 1822 if (lineLen >= 60) { 1823 lineLen = 0; 1824 Tcl_AppendResult(interp, "\n", (char *) NULL); 1825 } 1826 } 1827 break; 1828 } 1829 default: { 1830 /* 1831 * Generate transparency data. 1832 * We must prevent a transparent value of 0 1833 * because of a bug in some HP printers. 1834 */ 1835 1836 for (xx = 0; xx < width; xx ++) { 1837 alpha = *(alphaPtr + (yy * alphaPitch) 1838 + (xx * alphaIncr) + alphaOffset); 1839 sprintf(buffer, "%02X", alpha | 0x01); 1840 Tcl_AppendResult(interp, buffer, (char *) NULL); 1841 lineLen += 2; 1842 if (lineLen >= 60) { 1843 lineLen = 0; 1844 Tcl_AppendResult(interp, "\n", (char *) NULL); 1845 } 1846 } 1847 1848 1849 /* 1850 * Finally, color mode. Here, just output the red, green, 1851 * and blue values directly. 1852 */ 1853 1854 for (xx = 0; xx < width; xx ++) { 1855 pixelPtr = blockPtr->pixelPtr 1856 + (yy * blockPtr->pitch) 1857 + (xx *blockPtr->pixelSize); 1858 1859 sprintf(buffer, "%02X%02X%02X", 1860 pixelPtr[blockPtr->offset[0]], 1861 pixelPtr[blockPtr->offset[1]], 1862 pixelPtr[blockPtr->offset[2]]); 1863 Tcl_AppendResult(interp, buffer, (char *) NULL); 1864 lineLen += 6; 1865 if (lineLen >= 60) { 1866 lineLen = 0; 1867 Tcl_AppendResult(interp, "\n", (char *) NULL); 1868 } 1869 } 1870 break; 1871 } 1872 } 1873 } 1874 1875 Tcl_AppendResult(interp, ">\n", (char *) NULL); 1876 return TCL_OK; 1877} 1878