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