home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / generic / tkCanvPs.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  35.7 KB  |  1,154 lines  |  [TEXT/CWIE]
  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-1996 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.  * SCCS: @(#) tkCanvPs.c 1.56 97/04/25 16:51:08
  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.  * One of the following structures is created to keep track of Postscript
  27.  * output being generated.  It consists mostly of information provided on
  28.  * the widget command line.
  29.  */
  30.  
  31. typedef struct TkPostscriptInfo {
  32.     int x, y, width, height;    /* Area to print, in canvas pixel
  33.                  * coordinates. */
  34.     int x2, y2;            /* x+width and y+height. */
  35.     char *pageXString;        /* String value of "-pagex" option or NULL. */
  36.     char *pageYString;        /* String value of "-pagey" option or NULL. */
  37.     double pageX, pageY;    /* Postscript coordinates (in points)
  38.                  * corresponding to pageXString and
  39.                  * pageYString. Don't forget that y-values
  40.                  * grow upwards for Postscript! */
  41.     char *pageWidthString;    /* Printed width of output. */
  42.     char *pageHeightString;    /* Printed height of output. */
  43.     double scale;        /* Scale factor for conversion: each pixel
  44.                  * maps into this many points. */
  45.     Tk_Anchor pageAnchor;    /* How to anchor bbox on Postscript page. */
  46.     int rotate;            /* Non-zero means output should be rotated
  47.                  * on page (landscape mode). */
  48.     char *fontVar;        /* If non-NULL, gives name of global variable
  49.                  * containing font mapping information.
  50.                  * Malloc'ed. */
  51.     char *colorVar;        /* If non-NULL, give name of global variable
  52.                  * containing color mapping information.
  53.                  * Malloc'ed. */
  54.     char *colorMode;        /* Mode for handling colors:  "monochrome",
  55.                  * "gray", or "color".  Malloc'ed. */
  56.     int colorLevel;        /* Numeric value corresponding to colorMode:
  57.                  * 0 for mono, 1 for gray, 2 for color. */
  58.     char *fileName;        /* Name of file in which to write Postscript;
  59.                  * NULL means return Postscript info as
  60.                  * result. Malloc'ed. */
  61.     char *channelName;        /* If -channel is specified, the name of
  62.                                  * the channel to use. */
  63.     Tcl_Channel chan;        /* Open channel corresponding to fileName. */
  64.     Tcl_HashTable fontTable;    /* Hash table containing names of all font
  65.                  * families used in output.  The hash table
  66.                  * values are not used. */
  67.     int prepass;        /* Non-zero means that we're currently in
  68.                  * the pre-pass that collects font information,
  69.                  * so the Postscript generated isn't
  70.                  * relevant. */
  71. } TkPostscriptInfo;
  72.  
  73. /*
  74.  * The table below provides a template that's used to process arguments
  75.  * to the canvas "postscript" command and fill in TkPostscriptInfo
  76.  * structures.
  77.  */
  78.  
  79. static Tk_ConfigSpec configSpecs[] = {
  80.     {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL,
  81.     "", Tk_Offset(TkPostscriptInfo, colorVar), 0},
  82.     {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL,
  83.     "", Tk_Offset(TkPostscriptInfo, colorMode), 0},
  84.     {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
  85.     "", Tk_Offset(TkPostscriptInfo, fileName), 0},
  86.     {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL,
  87.     "", Tk_Offset(TkPostscriptInfo, channelName), 0},
  88.     {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL,
  89.     "", Tk_Offset(TkPostscriptInfo, fontVar), 0},
  90.     {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
  91.     "", Tk_Offset(TkPostscriptInfo, height), 0},
  92.     {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL,
  93.     "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0},
  94.     {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL,
  95.     "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0},
  96.     {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL,
  97.     "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0},
  98.     {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL,
  99.     "", Tk_Offset(TkPostscriptInfo, pageXString), 0},
  100.     {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL,
  101.     "", Tk_Offset(TkPostscriptInfo, pageYString), 0},
  102.     {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL,
  103.     "", Tk_Offset(TkPostscriptInfo, rotate), 0},
  104.     {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
  105.     "", Tk_Offset(TkPostscriptInfo, width), 0},
  106.     {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL,
  107.     "", Tk_Offset(TkPostscriptInfo, x), 0},
  108.     {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL,
  109.     "", Tk_Offset(TkPostscriptInfo, y), 0},
  110.     {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
  111.     (char *) NULL, 0, 0}
  112. };
  113.  
  114. /*
  115.  * Forward declarations for procedures defined later in this file:
  116.  */
  117.  
  118. static int        GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
  119.                 char *string, double *doublePtr));
  120.  
  121. /*
  122.  *--------------------------------------------------------------
  123.  *
  124.  * TkCanvPostscriptCmd --
  125.  *
  126.  *    This procedure is invoked to process the "postscript" options
  127.  *    of the widget command for canvas widgets. See the user
  128.  *    documentation for details on what it does.
  129.  *
  130.  * Results:
  131.  *    A standard Tcl result.
  132.  *
  133.  * Side effects:
  134.  *    See the user documentation.
  135.  *
  136.  *--------------------------------------------------------------
  137.  */
  138.  
  139.     /* ARGSUSED */
  140. int
  141. TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
  142.     TkCanvas *canvasPtr;        /* Information about canvas widget. */
  143.     Tcl_Interp *interp;            /* Current interpreter. */
  144.     int argc;                /* Number of arguments. */
  145.     char **argv;            /* Argument strings.  Caller has
  146.                      * already parsed this command enough
  147.                      * to know that argv[1] is
  148.                      * "postscript". */
  149. {
  150.     TkPostscriptInfo psInfo, *oldInfoPtr;
  151.     int result;
  152.     Tk_Item *itemPtr;
  153. #define STRING_LENGTH 400
  154.     char string[STRING_LENGTH+1], *p;
  155.     time_t now;
  156. #if !(defined(__WIN32__) || defined(MAC_TCL))
  157.     struct passwd *pwPtr;
  158. #endif /* __WIN32__ || MAC_TCL */
  159.     size_t length;
  160.     int deltaX = 0, deltaY = 0;        /* Offset of lower-left corner of
  161.                      * area to be marked up, measured
  162.                      * in canvas units from the positioning
  163.                      * point on the page (reflects
  164.                      * anchor position).  Initial values
  165.                      * needed only to stop compiler
  166.                      * warnings. */
  167.     Tcl_HashSearch search;
  168.     Tcl_HashEntry *hPtr;
  169.     Tcl_DString buffer;
  170.  
  171.     /*
  172.      *----------------------------------------------------------------
  173.      * Initialize the data structure describing Postscript generation,
  174.      * then process all the arguments to fill the data structure in.
  175.      *----------------------------------------------------------------
  176.      */
  177.  
  178.     oldInfoPtr = canvasPtr->psInfoPtr;
  179.     canvasPtr->psInfoPtr = &psInfo;
  180.     psInfo.x = canvasPtr->xOrigin;
  181.     psInfo.y = canvasPtr->yOrigin;
  182.     psInfo.width = -1;
  183.     psInfo.height = -1;
  184.     psInfo.pageXString = NULL;
  185.     psInfo.pageYString = NULL;
  186.     psInfo.pageX = 72*4.25;
  187.     psInfo.pageY = 72*5.5;
  188.     psInfo.pageWidthString = NULL;
  189.     psInfo.pageHeightString = NULL;
  190.     psInfo.scale = 1.0;
  191.     psInfo.pageAnchor = TK_ANCHOR_CENTER;
  192.     psInfo.rotate = 0;
  193.     psInfo.fontVar = NULL;
  194.     psInfo.colorVar = NULL;
  195.     psInfo.colorMode = NULL;
  196.     psInfo.colorLevel = 0;
  197.     psInfo.fileName = NULL;
  198.     psInfo.channelName = NULL;
  199.     psInfo.chan = NULL;
  200.     psInfo.prepass = 0;
  201.     Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
  202.     result = Tk_ConfigureWidget(canvasPtr->interp, canvasPtr->tkwin,
  203.         configSpecs, argc-2, argv+2, (char *) &psInfo,
  204.         TK_CONFIG_ARGV_ONLY);
  205.     if (result != TCL_OK) {
  206.     goto cleanup;
  207.     }
  208.  
  209.     if (psInfo.width == -1) {
  210.     psInfo.width = Tk_Width(canvasPtr->tkwin);
  211.     }
  212.     if (psInfo.height == -1) {
  213.     psInfo.height = Tk_Height(canvasPtr->tkwin);
  214.     }
  215.     psInfo.x2 = psInfo.x + psInfo.width;
  216.     psInfo.y2 = psInfo.y + psInfo.height;
  217.  
  218.     if (psInfo.pageXString != NULL) {
  219.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageXString,
  220.         &psInfo.pageX) != TCL_OK) {
  221.         goto cleanup;
  222.     }
  223.     }
  224.     if (psInfo.pageYString != NULL) {
  225.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageYString,
  226.         &psInfo.pageY) != TCL_OK) {
  227.         goto cleanup;
  228.     }
  229.     }
  230.     if (psInfo.pageWidthString != NULL) {
  231.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageWidthString,
  232.         &psInfo.scale) != TCL_OK) {
  233.         goto cleanup;
  234.     }
  235.     psInfo.scale /= psInfo.width;
  236.     } else if (psInfo.pageHeightString != NULL) {
  237.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageHeightString,
  238.         &psInfo.scale) != TCL_OK) {
  239.         goto cleanup;
  240.     }
  241.     psInfo.scale /= psInfo.height;
  242.     } else {
  243.     psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(canvasPtr->tkwin));
  244.     psInfo.scale /= WidthOfScreen(Tk_Screen(canvasPtr->tkwin));
  245.     }
  246.     switch (psInfo.pageAnchor) {
  247.     case TK_ANCHOR_NW:
  248.     case TK_ANCHOR_W:
  249.     case TK_ANCHOR_SW:
  250.         deltaX = 0;
  251.         break;
  252.     case TK_ANCHOR_N:
  253.     case TK_ANCHOR_CENTER:
  254.     case TK_ANCHOR_S:
  255.         deltaX = -psInfo.width/2;
  256.         break;
  257.     case TK_ANCHOR_NE:
  258.     case TK_ANCHOR_E:
  259.     case TK_ANCHOR_SE:
  260.         deltaX = -psInfo.width;
  261.         break;
  262.     }
  263.     switch (psInfo.pageAnchor) {
  264.     case TK_ANCHOR_NW:
  265.     case TK_ANCHOR_N:
  266.     case TK_ANCHOR_NE:
  267.         deltaY = - psInfo.height;
  268.         break;
  269.     case TK_ANCHOR_W:
  270.     case TK_ANCHOR_CENTER:
  271.     case TK_ANCHOR_E:
  272.         deltaY = -psInfo.height/2;
  273.         break;
  274.     case TK_ANCHOR_SW:
  275.     case TK_ANCHOR_S:
  276.     case TK_ANCHOR_SE:
  277.         deltaY = 0;
  278.         break;
  279.     }
  280.  
  281.     if (psInfo.colorMode == NULL) {
  282.     psInfo.colorLevel = 2;
  283.     } else {
  284.     length = strlen(psInfo.colorMode);
  285.     if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
  286.         psInfo.colorLevel = 0;
  287.     } else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
  288.         psInfo.colorLevel = 1;
  289.     } else if (strncmp(psInfo.colorMode, "color", length) == 0) {
  290.         psInfo.colorLevel = 2;
  291.     } else {
  292.         Tcl_AppendResult(canvasPtr->interp, "bad color mode \"",
  293.             psInfo.colorMode, "\": must be monochrome, ",
  294.             "gray, or color", (char *) NULL);
  295.         goto cleanup;
  296.     }
  297.     }
  298.  
  299.     if (psInfo.fileName != NULL) {
  300.  
  301.         /*
  302.          * Check that -file and -channel are not both specified.
  303.          */
  304.  
  305.         if (psInfo.channelName != NULL) {
  306.             Tcl_AppendResult(canvasPtr->interp, "can't specify both -file",
  307.                     " and -channel", (char *) NULL);
  308.             result = TCL_ERROR;
  309.             goto cleanup;
  310.         }
  311.  
  312.         /*
  313.          * Check that we are not in a safe interpreter. If we are, disallow
  314.          * the -file specification.
  315.          */
  316.  
  317.         if (Tcl_IsSafe(canvasPtr->interp)) {
  318.             Tcl_AppendResult(canvasPtr->interp, "can't specify -file in a",
  319.                     " safe interpreter", (char *) NULL);
  320.             result = TCL_ERROR;
  321.             goto cleanup;
  322.         }
  323.         
  324.     p = Tcl_TranslateFileName(canvasPtr->interp, psInfo.fileName, &buffer);
  325.     if (p == NULL) {
  326.         goto cleanup;
  327.     }
  328.     psInfo.chan = Tcl_OpenFileChannel(canvasPtr->interp, p, "w", 0666);
  329.     Tcl_DStringFree(&buffer);
  330.     if (psInfo.chan == NULL) {
  331.         goto cleanup;
  332.     }
  333.     }
  334.  
  335.     if (psInfo.channelName != NULL) {
  336.         int mode;
  337.         
  338.         /*
  339.          * Check that the channel is found in this interpreter and that it
  340.          * is open for writing.
  341.          */
  342.  
  343.         psInfo.chan = Tcl_GetChannel(canvasPtr->interp, psInfo.channelName,
  344.                 &mode);
  345.         if (psInfo.chan == (Tcl_Channel) NULL) {
  346.             result = TCL_ERROR;
  347.             goto cleanup;
  348.         }
  349.         if ((mode & TCL_WRITABLE) == 0) {
  350.             Tcl_AppendResult(canvasPtr->interp, "channel \"",
  351.                     psInfo.channelName, "\" wasn't opened for writing",
  352.                     (char *) NULL);
  353.             result = TCL_ERROR;
  354.             goto cleanup;
  355.         }
  356.     }
  357.     
  358.     /*
  359.      *--------------------------------------------------------
  360.      * Make a pre-pass over all of the items, generating Postscript
  361.      * and then throwing it away.  The purpose of this pass is just
  362.      * to collect information about all the fonts in use, so that
  363.      * we can output font information in the proper form required
  364.      * by the Document Structuring Conventions.
  365.      *--------------------------------------------------------
  366.      */
  367.  
  368.     psInfo.prepass = 1;
  369.     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
  370.         itemPtr = itemPtr->nextPtr) {
  371.     if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
  372.         || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
  373.         continue;
  374.     }
  375.     if (itemPtr->typePtr->postscriptProc == NULL) {
  376.         continue;
  377.     }
  378.     result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
  379.         (Tk_Canvas) canvasPtr, itemPtr, 1);
  380.     Tcl_ResetResult(canvasPtr->interp);
  381.     if (result != TCL_OK) {
  382.         /*
  383.          * An error just occurred.  Just skip out of this loop.
  384.          * There's no need to report the error now;  it can be
  385.          * reported later (errors can happen later that don't
  386.          * happen now, so we still have to check for errors later
  387.          * anyway).
  388.          */
  389.         break;
  390.     }
  391.     }
  392.     psInfo.prepass = 0;
  393.  
  394.     /*
  395.      *--------------------------------------------------------
  396.      * Generate the header and prolog for the Postscript.
  397.      *--------------------------------------------------------
  398.      */
  399.  
  400.     Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
  401.         "%%Creator: Tk Canvas Widget\n", (char *) NULL);
  402. #if !(defined(__WIN32__) || defined(MAC_TCL))
  403.     pwPtr = getpwuid(getuid());
  404.     Tcl_AppendResult(canvasPtr->interp, "%%For: ",
  405.         (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
  406.         (char *) NULL);
  407.     endpwent();
  408. #endif /* __WIN32__ || MAC_TCL */
  409.     Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ",
  410.         Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL);
  411.     time(&now);
  412.     Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ",
  413.         ctime(&now), (char *) NULL);
  414.     if (!psInfo.rotate) {
  415.     sprintf(string, "%d %d %d %d",
  416.         (int) (psInfo.pageX + psInfo.scale*deltaX),
  417.         (int) (psInfo.pageY + psInfo.scale*deltaY),
  418.         (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
  419.             + 1.0),
  420.         (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
  421.             + 1.0));
  422.     } else {
  423.     sprintf(string, "%d %d %d %d",
  424.         (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)),
  425.         (int) (psInfo.pageY + psInfo.scale*deltaX),
  426.         (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
  427.         (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
  428.             + 1.0));
  429.     }
  430.     Tcl_AppendResult(canvasPtr->interp, "%%BoundingBox: ", string,
  431.         "\n", (char *) NULL);
  432.     Tcl_AppendResult(canvasPtr->interp, "%%Pages: 1\n", 
  433.         "%%DocumentData: Clean7Bit\n", (char *) NULL);
  434.     Tcl_AppendResult(canvasPtr->interp, "%%Orientation: ",
  435.         psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL);
  436.     p = "%%DocumentNeededResources: font ";
  437.     for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
  438.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  439.     Tcl_AppendResult(canvasPtr->interp, p,
  440.         Tcl_GetHashKey(&psInfo.fontTable, hPtr),
  441.         "\n", (char *) NULL);
  442.     p = "%%+ font ";
  443.     }
  444.     Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL);
  445.  
  446.     /*
  447.      * Read a standard prolog file in a native way and insert it into
  448.      * the Postscript.
  449.      */
  450.  
  451.     if (TkGetNativeProlog(canvasPtr->interp) != TCL_OK) {
  452.     goto cleanup;
  453.     }
  454.     if (psInfo.chan != NULL) {
  455.     Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
  456.     Tcl_ResetResult(canvasPtr->interp);
  457.     }
  458.  
  459.     /*
  460.      *-----------------------------------------------------------
  461.      * Document setup:  set the color level and include fonts.
  462.      *-----------------------------------------------------------
  463.      */
  464.  
  465.     sprintf(string, "/CL %d def\n", psInfo.colorLevel);
  466.     Tcl_AppendResult(canvasPtr->interp, "%%BeginSetup\n", string,
  467.         (char *) NULL);
  468.     for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
  469.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  470.     Tcl_AppendResult(canvasPtr->interp, "%%IncludeResource: font ",
  471.         Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL);
  472.     }
  473.     Tcl_AppendResult(canvasPtr->interp, "%%EndSetup\n\n", (char *) NULL);
  474.  
  475.     /*
  476.      *-----------------------------------------------------------
  477.      * Page setup:  move to page positioning point, rotate if
  478.      * needed, set scale factor, offset for proper anchor position,
  479.      * and set clip region.
  480.      *-----------------------------------------------------------
  481.      */
  482.  
  483.     Tcl_AppendResult(canvasPtr->interp, "%%Page: 1 1\n", "save\n",
  484.         (char *) NULL);
  485.     sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
  486.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  487.     if (psInfo.rotate) {
  488.     Tcl_AppendResult(canvasPtr->interp, "90 rotate\n", (char *) NULL);
  489.     }
  490.     sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
  491.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  492.     sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
  493.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  494.     sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
  495.         psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
  496.         psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
  497.         psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2),
  498.         psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2));
  499.     Tcl_AppendResult(canvasPtr->interp, string,
  500.     " lineto closepath clip newpath\n", (char *) NULL);
  501.     if (psInfo.chan != NULL) {
  502.     Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
  503.     Tcl_ResetResult(canvasPtr->interp);
  504.     }
  505.  
  506.     /*
  507.      *---------------------------------------------------------------------
  508.      * Iterate through all the items, having each relevant one draw itself.
  509.      * Quit if any of the items returns an error.
  510.      *---------------------------------------------------------------------
  511.      */
  512.  
  513.     result = TCL_OK;
  514.     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
  515.         itemPtr = itemPtr->nextPtr) {
  516.     if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
  517.         || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
  518.         continue;
  519.     }
  520.     if (itemPtr->typePtr->postscriptProc == NULL) {
  521.         continue;
  522.     }
  523.     Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL);
  524.     result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
  525.         (Tk_Canvas) canvasPtr, itemPtr, 0);
  526.     if (result != TCL_OK) {
  527.         char msg[100];
  528.  
  529.         sprintf(msg, "\n    (generating Postscript for item %d)",
  530.             itemPtr->id);
  531.         Tcl_AddErrorInfo(canvasPtr->interp, msg);
  532.         goto cleanup;
  533.     }
  534.     Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL);
  535.     if (psInfo.chan != NULL) {
  536.         Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
  537.         Tcl_ResetResult(canvasPtr->interp);
  538.     }
  539.     }
  540.  
  541.     /*
  542.      *---------------------------------------------------------------------
  543.      * Output page-end information, such as commands to print the page
  544.      * and document trailer stuff.
  545.      *---------------------------------------------------------------------
  546.      */
  547.  
  548.     Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n",
  549.         "%%Trailer\nend\n%%EOF\n", (char *) NULL);
  550.     if (psInfo.chan != NULL) {
  551.     Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
  552.     Tcl_ResetResult(canvasPtr->interp);
  553.     }
  554.  
  555.     /*
  556.      * Clean up psInfo to release malloc'ed stuff.
  557.      */
  558.  
  559.     cleanup:
  560.     if (psInfo.pageXString != NULL) {
  561.     ckfree(psInfo.pageXString);
  562.     }
  563.     if (psInfo.pageYString != NULL) {
  564.     ckfree(psInfo.pageYString);
  565.     }
  566.     if (psInfo.pageWidthString != NULL) {
  567.     ckfree(psInfo.pageWidthString);
  568.     }
  569.     if (psInfo.pageHeightString != NULL) {
  570.     ckfree(psInfo.pageHeightString);
  571.     }
  572.     if (psInfo.fontVar != NULL) {
  573.     ckfree(psInfo.fontVar);
  574.     }
  575.     if (psInfo.colorVar != NULL) {
  576.     ckfree(psInfo.colorVar);
  577.     }
  578.     if (psInfo.colorMode != NULL) {
  579.     ckfree(psInfo.colorMode);
  580.     }
  581.     if (psInfo.fileName != NULL) {
  582.     ckfree(psInfo.fileName);
  583.     }
  584.     if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
  585.     Tcl_Close(canvasPtr->interp, psInfo.chan);
  586.     }
  587.     if (psInfo.channelName != NULL) {
  588.         ckfree(psInfo.channelName);
  589.     }
  590.     Tcl_DeleteHashTable(&psInfo.fontTable);
  591.     canvasPtr->psInfoPtr = oldInfoPtr;
  592.     return result;
  593. }
  594.  
  595. /*
  596.  *--------------------------------------------------------------
  597.  *
  598.  * Tk_CanvasPsColor --
  599.  *
  600.  *    This procedure is called by individual canvas items when
  601.  *    they want to set a color value for output.  Given information
  602.  *    about an X color, this procedure will generate Postscript
  603.  *    commands to set up an appropriate color in Postscript.
  604.  *
  605.  * Results:
  606.  *    Returns a standard Tcl return value.  If an error occurs
  607.  *    then an error message will be left in interp->result.
  608.  *    If no error occurs, then additional Postscript will be
  609.  *    appended to interp->result.
  610.  *
  611.  * Side effects:
  612.  *    None.
  613.  *
  614.  *--------------------------------------------------------------
  615.  */
  616.  
  617. int
  618. Tk_CanvasPsColor(interp, canvas, colorPtr)
  619.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  620.                      * or error message. */
  621.     Tk_Canvas canvas;            /* Information about canvas. */
  622.     XColor *colorPtr;            /* Information about color. */
  623. {
  624.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  625.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  626.     int tmp;
  627.     double red, green, blue;
  628.     char string[200];
  629.  
  630.     if (psInfoPtr->prepass) {
  631.     return TCL_OK;
  632.     }
  633.  
  634.     /*
  635.      * If there is a color map defined, then look up the color's name
  636.      * in the map and use the Postscript commands found there, if there
  637.      * are any.
  638.      */
  639.  
  640.     if (psInfoPtr->colorVar != NULL) {
  641.     char *cmdString;
  642.  
  643.     cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
  644.         Tk_NameOfColor(colorPtr), 0);
  645.     if (cmdString != NULL) {
  646.         Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
  647.         return TCL_OK;
  648.     }
  649.     }
  650.  
  651.     /*
  652.      * No color map entry for this color.  Grab the color's intensities
  653.      * and output Postscript commands for them.  Special note:  X uses
  654.      * a range of 0-65535 for intensities, but most displays only use
  655.      * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
  656.      * X scale.  This means that there's no way to get perfect white,
  657.      * since the highest intensity is only 65280 out of 65535.  To
  658.      * work around this problem, rescale the X intensity to a 0-255
  659.      * scale and use that as the basis for the Postscript colors.  This
  660.      * scheme still won't work if the display only uses 4 bits per color,
  661.      * but most diplays use at least 8 bits.
  662.      */
  663.  
  664.     tmp = colorPtr->red;
  665.     red = ((double) (tmp >> 8))/255.0;
  666.     tmp = colorPtr->green;
  667.     green = ((double) (tmp >> 8))/255.0;
  668.     tmp = colorPtr->blue;
  669.     blue = ((double) (tmp >> 8))/255.0;
  670.     sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
  671.         red, green, blue);
  672.     Tcl_AppendResult(interp, string, (char *) NULL);
  673.     return TCL_OK;
  674. }
  675.  
  676. /*
  677.  *--------------------------------------------------------------
  678.  *
  679.  * Tk_CanvasPsFont --
  680.  *
  681.  *    This procedure is called by individual canvas items when
  682.  *    they want to output text.  Given information about an X
  683.  *    font, this procedure will generate Postscript commands
  684.  *    to set up an appropriate font in Postscript.
  685.  *
  686.  * Results:
  687.  *    Returns a standard Tcl return value.  If an error occurs
  688.  *    then an error message will be left in interp->result.
  689.  *    If no error occurs, then additional Postscript will be
  690.  *    appended to the interp->result.
  691.  *
  692.  * Side effects:
  693.  *    The Postscript font name is entered into psInfoPtr->fontTable
  694.  *    if it wasn't already there.
  695.  *
  696.  *--------------------------------------------------------------
  697.  */
  698.  
  699. int
  700. Tk_CanvasPsFont(interp, canvas, tkfont)
  701.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  702.                      * or error message. */
  703.     Tk_Canvas canvas;            /* Information about canvas. */
  704.     Tk_Font tkfont;            /* Information about font in which text
  705.                      * is to be printed. */
  706. {
  707.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  708.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  709.     char *end;
  710.     char pointString[20];
  711.     Tcl_DString ds;
  712.     int i, points;
  713.  
  714.     /*
  715.      * First, look up the font's name in the font map, if there is one.
  716.      * If there is an entry for this font, it consists of a list
  717.      * containing font name and size.  Use this information.
  718.      */
  719.  
  720.     Tcl_DStringInit(&ds);
  721.     
  722.     if (psInfoPtr->fontVar != NULL) {
  723.     char *list, **argv;
  724.     int argc;
  725.     double size;
  726.     char *name;
  727.  
  728.     name = Tk_NameOfFont(tkfont);
  729.     list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
  730.     if (list != NULL) {
  731.         if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) {
  732.         badMapEntry:
  733.         Tcl_ResetResult(interp);
  734.         Tcl_AppendResult(interp, "bad font map entry for \"", name,
  735.             "\": \"", list, "\"", (char *) NULL);
  736.         return TCL_ERROR;
  737.         }
  738.         if (argc != 2) {
  739.         goto badMapEntry;
  740.         }
  741.         size = strtod(argv[1], &end);
  742.         if ((size <= 0) || (*end != 0)) {
  743.         goto badMapEntry;
  744.         }
  745.  
  746.         Tcl_DStringAppend(&ds, argv[0], -1);
  747.         points = (int) size;
  748.         
  749.         ckfree((char *) argv);
  750.         goto findfont;
  751.     }
  752.     } 
  753.  
  754.     points = Tk_PostscriptFontName(tkfont, &ds);
  755.  
  756.     findfont:
  757.     sprintf(pointString, "%d", points);
  758.     Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ",
  759.         pointString, " scalefont ", (char *) NULL);
  760.     if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) {
  761.     Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL);
  762.     }
  763.     Tcl_AppendResult(interp, "setfont\n", (char *) NULL);
  764.     Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
  765.     Tcl_DStringFree(&ds);
  766.  
  767.     return TCL_OK;
  768. }
  769.  
  770. /*
  771.  *--------------------------------------------------------------
  772.  *
  773.  * Tk_CanvasPsBitmap --
  774.  *
  775.  *    This procedure is called to output the contents of a
  776.  *    sub-region of a bitmap in proper image data format for
  777.  *    Postscript (i.e. data between angle brackets, one bit
  778.  *    per pixel).
  779.  *
  780.  * Results:
  781.  *    Returns a standard Tcl return value.  If an error occurs
  782.  *    then an error message will be left in interp->result.
  783.  *    If no error occurs, then additional Postscript will be
  784.  *    appended to interp->result.
  785.  *
  786.  * Side effects:
  787.  *    None.
  788.  *
  789.  *--------------------------------------------------------------
  790.  */
  791.  
  792. int
  793. Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
  794.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  795.                      * or error message. */
  796.     Tk_Canvas canvas;            /* Information about canvas. */
  797.     Pixmap bitmap;            /* Bitmap for which to generate
  798.                      * Postscript. */
  799.     int startX, startY;            /* Coordinates of upper-left corner
  800.                      * of rectangular region to output. */
  801.     int width, height;            /* Height of rectangular region. */
  802. {
  803.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  804.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  805.     XImage *imagePtr;
  806.     int charsInLine, x, y, lastX, lastY, value, mask;
  807.     unsigned int totalWidth, totalHeight;
  808.     char string[100];
  809.     Window dummyRoot;
  810.     int dummyX, dummyY;
  811.     unsigned dummyBorderwidth, dummyDepth;
  812.  
  813.     if (psInfoPtr->prepass) {
  814.     return TCL_OK;
  815.     }
  816.  
  817.     /*
  818.      * The following call should probably be a call to Tk_SizeOfBitmap
  819.      * instead, but it seems that we are occasionally invoked by custom
  820.      * item types that create their own bitmaps without registering them
  821.      * with Tk.  XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
  822.      * it shouldn't matter here.
  823.      */
  824.  
  825.     XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
  826.         (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
  827.         (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
  828.     imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0,
  829.         totalWidth, totalHeight, 1, XYPixmap);
  830.     Tcl_AppendResult(interp, "<", (char *) NULL);
  831.     mask = 0x80;
  832.     value = 0;
  833.     charsInLine = 0;
  834.     lastX = startX + width - 1;
  835.     lastY = startY + height - 1;
  836.     for (y = lastY; y >= startY; y--) {
  837.     for (x = startX; x <= lastX; x++) {
  838.         if (XGetPixel(imagePtr, x, y)) {
  839.         value |= mask;
  840.         }
  841.         mask >>= 1;
  842.         if (mask == 0) {
  843.         sprintf(string, "%02x", value);
  844.         Tcl_AppendResult(interp, string, (char *) NULL);
  845.         mask = 0x80;
  846.         value = 0;
  847.         charsInLine += 2;
  848.         if (charsInLine >= 60) {
  849.             Tcl_AppendResult(interp, "\n", (char *) NULL);
  850.             charsInLine = 0;
  851.         }
  852.         }
  853.     }
  854.     if (mask != 0x80) {
  855.         sprintf(string, "%02x", value);
  856.         Tcl_AppendResult(interp, string, (char *) NULL);
  857.         mask = 0x80;
  858.         value = 0;
  859.         charsInLine += 2;
  860.     }
  861.     }
  862.     Tcl_AppendResult(interp, ">", (char *) NULL);
  863.     XDestroyImage(imagePtr);
  864.     return TCL_OK;
  865. }
  866.  
  867. /*
  868.  *--------------------------------------------------------------
  869.  *
  870.  * Tk_CanvasPsStipple --
  871.  *
  872.  *    This procedure is called by individual canvas items when
  873.  *    they have created a path that they'd like to be filled with
  874.  *    a stipple pattern.  Given information about an X bitmap,
  875.  *    this procedure will generate Postscript commands to fill
  876.  *    the current clip region using a stipple pattern defined by the
  877.  *    bitmap.
  878.  *
  879.  * Results:
  880.  *    Returns a standard Tcl return value.  If an error occurs
  881.  *    then an error message will be left in interp->result.
  882.  *    If no error occurs, then additional Postscript will be
  883.  *    appended to interp->result.
  884.  *
  885.  * Side effects:
  886.  *    None.
  887.  *
  888.  *--------------------------------------------------------------
  889.  */
  890.  
  891. int
  892. Tk_CanvasPsStipple(interp, canvas, bitmap)
  893.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  894.                      * or error message. */
  895.     Tk_Canvas canvas;            /* Information about canvas. */
  896.     Pixmap bitmap;            /* Bitmap to use for stippling. */
  897. {
  898.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  899.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  900.     int width, height;
  901.     char string[100];
  902.     Window dummyRoot;
  903.     int dummyX, dummyY;
  904.     unsigned dummyBorderwidth, dummyDepth;
  905.  
  906.     if (psInfoPtr->prepass) {
  907.     return TCL_OK;
  908.     }
  909.  
  910.     /*
  911.      * The following call should probably be a call to Tk_SizeOfBitmap
  912.      * instead, but it seems that we are occasionally invoked by custom
  913.      * item types that create their own bitmaps without registering them
  914.      * with Tk.  XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
  915.      * it shouldn't matter here.
  916.      */
  917.  
  918.     XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
  919.         (int *) &dummyX, (int *) &dummyY, (unsigned *) &width,
  920.         (unsigned *) &height, &dummyBorderwidth, &dummyDepth);
  921.     sprintf(string, "%d %d ", width, height);
  922.     Tcl_AppendResult(interp, string, (char *) NULL);
  923.     if (Tk_CanvasPsBitmap(interp, (Tk_Canvas) canvasPtr, bitmap, 0, 0,
  924.         width, height) != TCL_OK) {
  925.     return TCL_ERROR;
  926.     }
  927.     Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
  928.     return TCL_OK;
  929. }
  930.  
  931. /*
  932.  *--------------------------------------------------------------
  933.  *
  934.  * Tk_CanvasPsY --
  935.  *
  936.  *    Given a y-coordinate in canvas coordinates, this procedure
  937.  *    returns a y-coordinate to use for Postscript output.
  938.  *
  939.  * Results:
  940.  *    Returns the Postscript coordinate that corresponds to
  941.  *    "y".
  942.  *
  943.  * Side effects:
  944.  *    None.
  945.  *
  946.  *--------------------------------------------------------------
  947.  */
  948.  
  949. double
  950. Tk_CanvasPsY(canvas, y)
  951.     Tk_Canvas canvas;            /* Token for canvas on whose behalf
  952.                      * Postscript is being generated. */
  953.     double y;                /* Y-coordinate in canvas coords. */
  954. {
  955.     TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
  956.  
  957.     return psInfoPtr->y2 - y;
  958. }
  959.  
  960. /*
  961.  *--------------------------------------------------------------
  962.  *
  963.  * Tk_CanvasPsPath --
  964.  *
  965.  *    Given an array of points for a path, generate Postscript
  966.  *    commands to create the path.
  967.  *
  968.  * Results:
  969.  *    Postscript commands get appended to what's in interp->result.
  970.  *
  971.  * Side effects:
  972.  *    None.
  973.  *
  974.  *--------------------------------------------------------------
  975.  */
  976.  
  977. void
  978. Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
  979.     Tcl_Interp *interp;            /* Put generated Postscript in this
  980.                      * interpreter's result field. */
  981.     Tk_Canvas canvas;            /* Canvas on whose behalf Postscript
  982.                      * is being generated. */
  983.     double *coordPtr;            /* Pointer to first in array of
  984.                      * 2*numPoints coordinates giving
  985.                      * points for path. */
  986.     int numPoints;            /* Number of points at *coordPtr. */
  987. {
  988.     TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
  989.     char buffer[200];
  990.  
  991.     if (psInfoPtr->prepass) {
  992.     return;
  993.     }
  994.     sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
  995.         Tk_CanvasPsY(canvas, coordPtr[1]));
  996.     Tcl_AppendResult(interp, buffer, (char *) NULL);
  997.     for (numPoints--, coordPtr += 2; numPoints > 0;
  998.         numPoints--, coordPtr += 2) {
  999.     sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0],
  1000.         Tk_CanvasPsY(canvas, coordPtr[1]));
  1001.     Tcl_AppendResult(interp, buffer, (char *) NULL);
  1002.     }
  1003. }
  1004.  
  1005. /*
  1006.  *--------------------------------------------------------------
  1007.  *
  1008.  * GetPostscriptPoints --
  1009.  *
  1010.  *    Given a string, returns the number of Postscript points
  1011.  *    corresponding to that string.
  1012.  *
  1013.  * Results:
  1014.  *    The return value is a standard Tcl return result.  If
  1015.  *    TCL_OK is returned, then everything went well and the
  1016.  *    screen distance is stored at *doublePtr;  otherwise
  1017.  *    TCL_ERROR is returned and an error message is left in
  1018.  *    interp->result.
  1019.  *
  1020.  * Side effects:
  1021.  *    None.
  1022.  *
  1023.  *--------------------------------------------------------------
  1024.  */
  1025.  
  1026. static int
  1027. GetPostscriptPoints(interp, string, doublePtr)
  1028.     Tcl_Interp *interp;        /* Use this for error reporting. */
  1029.     char *string;        /* String describing a screen distance. */
  1030.     double *doublePtr;        /* Place to store converted result. */
  1031. {
  1032.     char *end;
  1033.     double d;
  1034.  
  1035.     d = strtod(string, &end);
  1036.     if (end == string) {
  1037.     error:
  1038.     Tcl_AppendResult(interp, "bad distance \"", string,
  1039.         "\"", (char *) NULL);
  1040.     return TCL_ERROR;
  1041.     }
  1042.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  1043.     end++;
  1044.     }
  1045.     switch (*end) {
  1046.     case 'c':
  1047.         d *= 72.0/2.54;
  1048.         end++;
  1049.         break;
  1050.     case 'i':
  1051.         d *= 72.0;
  1052.         end++;
  1053.         break;
  1054.     case 'm':
  1055.         d *= 72.0/25.4;
  1056.         end++;
  1057.         break;
  1058.     case 0:
  1059.         break;
  1060.     case 'p':
  1061.         end++;
  1062.         break;
  1063.     default:
  1064.         goto error;
  1065.     }
  1066.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  1067.     end++;
  1068.     }
  1069.     if (*end != 0) {
  1070.     goto error;
  1071.     }
  1072.     *doublePtr = d;
  1073.     return TCL_OK;
  1074. }
  1075.  
  1076. /*
  1077.  *--------------------------------------------------------------
  1078.  *
  1079.  * TkGetProlog --
  1080.  *
  1081.  *    Locate and load the postscript prolog.
  1082.  *
  1083.  * Results:
  1084.  *    A standard Tcl Result.  If everything is OK the prolog
  1085.  *    will be located in the result string of the interpreter.
  1086.  *
  1087.  * Side effects:
  1088.  *    None.
  1089.  *
  1090.  *--------------------------------------------------------------
  1091.  */
  1092.  
  1093. int
  1094. TkGetProlog(interp)
  1095.     Tcl_Interp *interp;        /* Places the prolog in the result. */
  1096. {
  1097.     char *libDir;
  1098.     Tcl_Channel chan;
  1099.     Tcl_DString buffer, buffer2;
  1100.     char *prologPathParts[2];
  1101.     int bufferSize;
  1102.     char *prologBuffer;
  1103.  
  1104.     libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
  1105.     if (libDir == NULL) {
  1106.     Tcl_ResetResult(interp);
  1107.     Tcl_AppendResult(interp, "couldn't find library directory: ",
  1108.         "tk_library variable doesn't exist", (char *) NULL);
  1109.     return TCL_ERROR;
  1110.     }
  1111.     Tcl_TranslateFileName(interp, libDir, &buffer);
  1112.     prologPathParts[0] = buffer.string;
  1113.     prologPathParts[1] = "prolog.ps";
  1114.     Tcl_DStringInit(&buffer2);
  1115.     Tcl_JoinPath(2, prologPathParts, &buffer2);
  1116.     Tcl_DStringFree(&buffer);
  1117.  
  1118.     /*
  1119.      * Compute size of file by seeking to the end of the file.  This will
  1120.      * overallocate if we are performing CRLF translation.
  1121.      */
  1122.     
  1123.     chan = Tcl_OpenFileChannel(interp, buffer2.string, "r", 0);
  1124.     if (chan == NULL) {
  1125.     Tcl_DStringFree(&buffer2);
  1126.     return TCL_ERROR;
  1127.     }
  1128.     bufferSize = Tcl_Seek(chan, 0L, SEEK_END);
  1129.     (void) Tcl_Seek(chan, 0L, SEEK_SET);
  1130.     if (bufferSize < 0) {
  1131.     Tcl_AppendResult(interp, "error seeking to end of file \"",
  1132.         buffer2.string, "\":", Tcl_PosixError(interp), (char *) NULL);
  1133.     Tcl_Close(NULL, chan);
  1134.     Tcl_DStringFree(&buffer2);
  1135.     return TCL_ERROR;
  1136.  
  1137.     }
  1138.     prologBuffer = (char *) ckalloc((unsigned) bufferSize+1);
  1139.     bufferSize = Tcl_Read(chan, prologBuffer, bufferSize);
  1140.     Tcl_Close(NULL, chan);
  1141.     if (bufferSize < 0) {
  1142.     Tcl_AppendResult(interp, "error reading file \"", buffer2.string, 
  1143.         "\":", Tcl_PosixError(interp), (char *) NULL);
  1144.     Tcl_DStringFree(&buffer2);
  1145.     return TCL_ERROR;
  1146.     }
  1147.     Tcl_DStringFree(&buffer2);
  1148.     prologBuffer[bufferSize] = 0;
  1149.     Tcl_AppendResult(interp, prologBuffer, (char *) NULL);
  1150.     ckfree(prologBuffer);
  1151.     
  1152.     return TCL_OK;
  1153. }
  1154.