开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
tkCanvPs.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：55k
源码类别：

通讯编程

开发平台：

Visual C++

tkCanvPs.c：源码内容
  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.  */
  17. #include "tkInt.h"
  18. #include "tkCanvas.h"
  19. #include "tkPort.h"
  21. /*
  22.  * See tkCanvas.h for key data structures used to implement canvases.
  23.  */
  25. /*
  26.  * The following definition is used in generating postscript for images
  27.  * and windows.
  28.  */
  30. typedef 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;
  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.  */
  45. typedef 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;
  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.  */
  95. static 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. };
  132. /*
  133.  * Forward declarations for procedures defined later in this file:
  134.  */
  136. static int GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
  137.     char *string, double *doublePtr));
  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.  */
  157.     /* ARGSUSED */
  158. int
  159. TkCanvPostscriptCmd(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";
  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.     }
  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;
  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.     }
  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.     }
  322.     if (psInfo.fileName != NULL) {
  324.         /*
  325.          * Check that -file and -channel are not both specified.
  326.          */
  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.         }
  335.         /*
  336.          * Check that we are not in a safe interpreter. If we are, disallow
  337.          * the -file specification.
  338.          */
  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.     }
  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.          */
  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.      */
  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;
  417.     /*
  418.      *--------------------------------------------------------
  419.      * Generate the header and prolog for the Postscript.
  420.      *--------------------------------------------------------
  421.      */
  423.     if (psInfo.prolog) {
  424.       Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0n",
  425.        "%%Creator: Tk Canvas Widgetn", (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: 1n", 
  459.     "%%DocumentData: Clean7Bitn", (char *) NULL);
  460.     Tcl_AppendResult(interp, "%%Orientation: ",
  461.     psInfo.rotate ? "Landscapen" : "Portraitn", (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, "%%EndCommentsnn", (char *) NULL);
  472.     /*
  473.      * Insert the prolog
  474.      */
  475.     Tcl_AppendResult(interp, Tcl_GetVar(interp,"::tk::ps_preamable",
  476.     TCL_GLOBAL_ONLY), (char *) NULL);
  478.     if (psInfo.chan != NULL) {
  479.         Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
  480. Tcl_ResetResult(canvasPtr->interp);
  481.     }
  483.     /*
  484.      *-----------------------------------------------------------
  485.      * Document setup:  set the color level and include fonts.
  486.      *-----------------------------------------------------------
  487.      */
  489.     sprintf(string, "/CL %d defn", psInfo.colorLevel);
  490.     Tcl_AppendResult(interp, "%%BeginSetupn", 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, "%%EndSetupnn", (char *) NULL);
  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.      */
  507.     Tcl_AppendResult(interp, "%%Page: 1 1n", "saven",
  508.     (char *) NULL);
  509.     sprintf(string, "%.1f %.1f translaten", psInfo.pageX, psInfo.pageY);
  510.     Tcl_AppendResult(interp, string, (char *) NULL);
  511.     if (psInfo.rotate) {
  512. Tcl_AppendResult(interp, "90 rotaten", (char *) NULL);
  513.     }
  514.     sprintf(string, "%.4g %.4g scalen", psInfo.scale, psInfo.scale);
  515.     Tcl_AppendResult(interp, string, (char *) NULL);
  516.     sprintf(string, "%d %d translaten", 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 newpathn", (char *) NULL);
  529.     }
  530.     if (psInfo.chan != NULL) {
  531. Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
  532. Tcl_ResetResult(canvasPtr->interp);
  533.     }
  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.      */
  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, "gsaven", (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];
  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, "grestoren", (char *) NULL);
  567. if (psInfo.chan != NULL) {
  568.     Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
  569.     Tcl_ResetResult(interp);
  570. }
  571.     }
  573.     /*
  574.      *---------------------------------------------------------------------
  575.      * Output page-end information, such as commands to print the page
  576.      * and document trailer stuff.
  577.      *---------------------------------------------------------------------
  578.      */
  580.     if (psInfo.prolog) {
  581.       Tcl_AppendResult(interp, "restore showpagenn",
  582.     "%%Trailernendn%%EOFn", (char *) NULL);
  583.     }
  584.     if (psInfo.chan != NULL) {
  585. Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
  586. Tcl_ResetResult(canvasPtr->interp);
  587.     }
  589.     /*
  590.      * Clean up psInfo to release malloc'ed stuff.
  591.      */
  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. }
  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.  */
  651. int
  652. Tk_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];
  662.     if (psInfoPtr->prepass) {
  663. return TCL_OK;
  664.     }
  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.      */
  672.     if (psInfoPtr->colorVar != NULL) {
  673. CONST char *cmdString;
  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.     }
  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.      */
  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 AdjustColorn",
  703.     red, green, blue);
  704.     Tcl_AppendResult(interp, string, (char *) NULL);
  705.     return TCL_OK;
  706. }
  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.  */
  731. int
  732. Tk_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;
  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.      */
  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;
  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.     }
  777.     Tcl_DStringAppend(&ds, argv[0], -1);
  778.     points = (int) size;
  779.     
  780.     ckfree((char *) argv);
  781.     goto findfont;
  782. }
  783.     } 
  785.     points = Tk_PostscriptFontName(tkfont, &ds);
  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, "setfontn", (char *) NULL);
  795.     Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
  796.     Tcl_DStringFree(&ds);
  798.     return TCL_OK;
  799. }
  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.  */
  823. int
  824. Tk_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;
  844.     if (psInfoPtr->prepass) {
  845. return TCL_OK;
  846.     }
  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.      */
  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. }
  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.  */
  922. int
  923. Tk_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;
  937.     if (psInfoPtr->prepass) {
  938. return TCL_OK;
  939.     }
  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.      */
  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, " StippleFilln", (char *) NULL);
  959.     return TCL_OK;
  960. }
  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.  */
  980. double
  981. Tk_PostscriptY(y, psInfo)
  982.     double y; /* Y-coordinate in canvas coords. */
  983.     Tk_PostscriptInfo psInfo; /* Postscript info */
  984. {
  985.     TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
  987.     return psInfoPtr->y2 - y;
  988. }
  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.  */
  1007. void
  1008. Tk_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];
  1020.     if (psInfoPtr->prepass) {
  1021. return;
  1022.     }
  1023.     sprintf(buffer, "%.15g %.15g moveton", 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 lineton", coordPtr[0],
  1029. Tk_PostscriptY(coordPtr[1], psInfo));
  1030. Tcl_AppendResult(interp, buffer, (char *) NULL);
  1031.     }
  1032. }
  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.  */
  1055. static int
  1056. GetPostscriptPoints(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;
  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 != '') && 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 != '') && isspace(UCHAR(*end))) {
  1096. end++;
  1097.     }
  1098.     if (*end != 0) {
  1099. goto error;
  1100.     }
  1101.     *doublePtr = d;
  1102.     return TCL_OK;
  1103. }
  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>
  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
  1146. #if defined(WIN32) || defined(MAC_OSX_TK)
  1147. static void
  1148. TkImageGetColor(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
  1158. static void
  1159. TkImageGetColor(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
  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.  */
  1202. int
  1203. TkPostscriptImage(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;
  1222.     if (psInfoPtr->prepass) {
  1223. return TCL_OK;
  1224.     }
  1226.     cmap = Tk_Colormap(tkwin);
  1227.     visual = Tk_Visual(tkwin);
  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.      */
  1235.     ncolors = visual->map_entries;
  1236.     cdata.colors = (XColor *) ckalloc(sizeof(XColor) * ncolors);
  1237.     cdata.ncolors = ncolors;
  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;
  1268.     XQueryColors(Tk_Display(tkwin), cmap, cdata.colors, ncolors);
  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.      */
  1276.     if (!cdata.color && level == 2) {
  1277. level = 1;
  1278.     }
  1280.     if (!cdata.color && cdata.ncolors == 2) {
  1281. level = 0;
  1282.     }
  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.      */
  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.     }
  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.     }
  1306.     maxRows = 60000 / bytesPerLine;
  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} imagen"); break;
  1406.     case 1: sprintf(buffer, ">n} imagen"); break;
  1407.     case 2: sprintf(buffer, ">n} false 3 colorimagen"); break;
  1408. }
  1409. Tcl_AppendResult(interp, buffer, (char *) NULL);
  1410. sprintf(buffer, "0 %d translaten", rows);
  1411. Tcl_AppendResult(interp, buffer, (char *) NULL);
  1412.     }
  1413.     ckfree((char *) cdata.colors);
  1414.     return TCL_OK;
  1415. }
  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.  */
  1438. int
  1439. Tk_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;
  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;
  1457.     unsigned char opaque = 255;
  1458.     unsigned char *alphaPtr;
  1459.     int alphaOffset, alphaPitch, alphaIncr;
  1461.     if (psInfoPtr->prepass) {
  1462. codeIncluded = 0;
  1463. return TCL_OK;
  1464.     }
  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.      */
  1474.     if( !codeIncluded && (colorLevel != 0) ) {
  1475. /*
  1476.  * Color and gray-scale code.
  1477.  */
  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 nnn", (char *) NULL);
  1550.     } else if( !codeIncluded && (colorLevel == 0) ) {
  1551. /*
  1552.  * Monochrome-only code
  1553.  */
  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 nnn", (char *) NULL);
  1594.     }
  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.      */
  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.     }
  1617.     /*
  1618.      * Set up the postscript code except for the image-data stream.
  1619.      */
  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.     }
  1640.     Tcl_AppendResult(interp,
  1641.     cspace, " setcolorspacenn", (char *) NULL);
  1643.     sprintf(buffer,
  1644.     "  /Width %dn  /Height %dn  /BitsPerComponent %dn",
  1645.     width, height,  bpc);
  1646.     Tcl_AppendResult(interp,
  1647.     "<<n  /ImageType 1n", buffer,
  1648.     "  /DataSource currentfile",
  1649.     "  /ASCIIHexDecode filtern", (char *) NULL);
  1652.     sprintf(buffer,
  1653.     "  /ImageMatrix [1 0 0 -1 0 %d]n", height);
  1654.     Tcl_AppendResult(interp, buffer,
  1655.     "  /Decode ", decode, "n>>n1 TkPhoton", (char *) NULL);
  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.      */
  1665.     if (blockPtr->pixelSize == 3) {
  1666. /*
  1667.  * No alpha information: the whole image is opaque.
  1668.  */
  1670. alphaPtr = &opaque;
  1671. alphaPitch = alphaIncr = alphaOffset = 0;
  1672.     } else {
  1673. /*
  1674.  * Set up alpha handling.
  1675.  */
  1677. alphaPtr = blockPtr->pixelPtr;
  1678. alphaPitch = blockPtr->pitch;
  1679. alphaIncr = blockPtr->pixelSize;
  1680. alphaOffset = blockPtr->offset[3];
  1681.     }
  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.  */
  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);
  1702.     red = pixelPtr[blockPtr->offset[0]];
  1703.     green = pixelPtr[blockPtr->offset[1]];
  1704.     blue = pixelPtr[blockPtr->offset[2]];
  1706.     alpha = *(alphaPtr + (yy * alphaPitch)
  1707.     + (xx * alphaIncr) + alphaOffset);
  1709.     /*
  1710.      * If pixel is less than threshold, then it is black.
  1711.      */
  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. }
  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);
  1746.     red = pixelPtr[blockPtr->offset[0]];
  1747.     green = pixelPtr[blockPtr->offset[1]];
  1748.     blue = pixelPtr[blockPtr->offset[2]];
  1750.     alpha = *(alphaPtr + (yy * alphaPitch)
  1751.     + (xx * alphaIncr) + alphaOffset);
  1752.     
  1753.     /*
  1754.      * If pixel is greater than threshold, then it is white.
  1755.      */
  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.  */
  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. }
  1804. /*
  1805.  * Generate data in gray mode--in this case, take a 
  1806.  * weighted sum of the red, green, and blue values.
  1807.  */
  1809. for (xx = 0; xx < width; xx ++) {
  1810.     pixelPtr = blockPtr->pixelPtr 
  1811. + (yy * blockPtr->pitch) 
  1812. + (xx *blockPtr->pixelSize);
  1814.     red = pixelPtr[blockPtr->offset[0]];
  1815.     green = pixelPtr[blockPtr->offset[1]];
  1816.     blue = pixelPtr[blockPtr->offset[2]];
  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.  */
  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. }
  1849. /*
  1850.  * Finally, color mode.  Here, just output the red, green,
  1851.  * and blue values directly.
  1852.  */
  1854. for (xx = 0; xx < width; xx ++) {
  1855.     pixelPtr = blockPtr->pixelPtr 
  1856. + (yy * blockPtr->pitch) 
  1857. + (xx *blockPtr->pixelSize);
  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.     }
  1875.     Tcl_AppendResult(interp, ">n", (char *) NULL);
  1876.     return TCL_OK;
  1877. }