home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcltk805.zip / tcl805s.zip / tk8.0.5 / os2 / tkCanvPs.c < prev    next >
C/C++ Source or Header  |  1999-04-24  |  45KB  |  1,387 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.  * RCS: @(#) $Id: tkCanvPs.c,v 1.4 1998/09/22 18:57:16 stanton Exp $
  15.  */
  16.  
  17. #include "tkInt.h"
  18. #include "tkCanvas.h"
  19. #include "tkPort.h"
  20.  
  21. /*
  22.  * See tkCanvas.h for key data structures used to implement canvases.
  23.  */
  24.  
  25. /*
  26.  * 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.  * The prolog data. Generated by str2c from prolog.ps
  116.  * This was split in small chunks by str2c because
  117.  * some C compiler have limitations on the size of static strings.
  118.  */
  119. static CONST char * CONST  prolog[]= {
  120.     /* Start of part 1 (2000 characters) */
  121.     "%%BeginProlog\n\
  122. 50 dict begin\n\
  123. \n\
  124. % This is a standard prolog for Postscript generated by Tk's canvas\n\
  125. % widget.\n\
  126. % RCS: @(#) $Id: tkCanvPs.c,v 1.4 1998/09/22 18:57:16 stanton Exp $\n\
  127. \n\
  128. % The definitions below just define all of the variables used in\n\
  129. % any of the procedures here.  This is needed for obscure reasons\n\
  130. % explained on p. 716 of the Postscript manual (Section H.2.7,\n\
  131. % \"Initializing Variables,\" in the section on Encapsulated Postscript).\n\
  132. \n\
  133. /baseline 0 def\n\
  134. /stipimage 0 def\n\
  135. /height 0 def\n\
  136. /justify 0 def\n\
  137. /lineLength 0 def\n\
  138. /spacing 0 def\n\
  139. /stipple 0 def\n\
  140. /strings 0 def\n\
  141. /xoffset 0 def\n\
  142. /yoffset 0 def\n\
  143. /tmpstip null def\n\
  144. \n\
  145. % Define the array ISOLatin1Encoding (which specifies how characters are\n\
  146. % encoded for ISO-8859-1 fonts), if it isn't already present (Postscript\n\
  147. % level 2 is supposed to define it, but level 1 doesn't).\n\
  148. \n\
  149. systemdict /ISOLatin1Encoding known not {\n\
  150.     /ISOLatin1Encoding [\n\
  151.     /space /space /space /space /space /space /space /space\n\
  152.     /space /space /space /space /space /space /space /space\n\
  153.     /space /space /space /space /space /space /space /space\n\
  154.     /space /space /space /space /space /space /space /space\n\
  155.     /space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n\
  156.         /quoteright\n\
  157.     /parenleft /parenright /asterisk /plus /comma /minus /period /slash\n\
  158.     /zero /one /two /three /four /five /six /seven\n\
  159.     /eight /nine /colon /semicolon /less /equal /greater /question\n\
  160.     /at /A /B /C /D /E /F /G\n\
  161.     /H /I /J /K /L /M /N /O\n\
  162.     /P /Q /R /S /T /U /V /W\n\
  163.     /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore\n\
  164.     /quoteleft /a /b /c /d /e /f /g\n\
  165.     /h /i /j /k /l /m /n /o\n\
  166.     /p /q /r /s /t /u /v /w\n\
  167.     /x /y /z /braceleft /bar /braceright /asciitilde /space\n\
  168.     /space /space /space /space /space /space /space /space\n\
  169.     /space /space /space /space /space /space /space /space\n\
  170.     /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n\
  171.     /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron\n\
  172.     /space /exclamdown /cent /sterling /currency /yen /brokenbar /section\n\
  173.     /dieresis /copyright /ordfem",
  174.     /* End of part 1 */
  175.  
  176.     /* Start of part 2 (2000 characters) */
  177.     "inine /guillemotleft /logicalnot /hyphen\n\
  178.         /registered /macron\n\
  179.     /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n\
  180.         /periodcentered\n\
  181.     /cedillar /onesuperior /ordmasculine /guillemotright /onequarter\n\
  182.         /onehalf /threequarters /questiondown\n\
  183.     /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla\n\
  184.     /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex\n\
  185.         /Idieresis\n\
  186.     /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n\
  187.     /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n\
  188.         /germandbls\n\
  189.     /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla\n\
  190.     /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex\n\
  191.         /idieresis\n\
  192.     /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide\n\
  193.     /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn\n\
  194.         /ydieresis\n\
  195.     ] def\n\
  196. } if\n\
  197. \n\
  198. % font ISOEncode font\n\
  199. % This procedure changes the encoding of a font from the default\n\
  200. % Postscript encoding to ISOLatin1.  It's typically invoked just\n\
  201. % before invoking \"setfont\".  The body of this procedure comes from\n\
  202. % Section 5.6.1 of the Postscript book.\n\
  203. \n\
  204. /ISOEncode {\n\
  205.     dup length dict begin\n\
  206.     {1 index /FID ne {def} {pop pop} ifelse} forall\n\
  207.     /Encoding ISOLatin1Encoding def\n\
  208.     currentdict\n\
  209.     end\n\
  210. \n\
  211.     % I'm not sure why it's necessary to use \"definefont\" on this new\n\
  212.     % font, but it seems to be important; just use the name \"Temporary\"\n\
  213.     % for the font.\n\
  214. \n\
  215.     /Temporary exch definefont\n\
  216. } bind def\n\
  217. \n\
  218. % StrokeClip\n\
  219. %\n\
  220. % This procedure converts the current path into a clip area under\n\
  221. % the assumption of stroking.  It's a bit tricky because some Postscript\n\
  222. % interpreters get errors during strokepath for dashed lines.  If\n\
  223. % this happens then turn off dashes and try again.\n\
  224. \n\
  225. /StrokeClip {\n\
  226.     {strokepath} stopped {\n\
  227.     (This Postscript printer gets limitcheck overflows when) =\n\
  228.     (stippling dashed lines;  lines will be printed solid instead.) =\n\
  229.     [] 0 setdash strokepath} if\n\
  230.     clip\n\
  231. } bind def\n\
  232. \n\
  233. % d",
  234.     /* End of part 2 */
  235.  
  236.     /* Start of part 3 (2000 characters) */
  237.     "esiredSize EvenPixels closestSize\n\
  238. %\n\
  239. % The procedure below is used for stippling.  Given the optimal size\n\
  240. % of a dot in a stipple pattern in the current user coordinate system,\n\
  241. % compute the closest size that is an exact multiple of the device's\n\
  242. % pixel size.  This allows stipple patterns to be displayed without\n\
  243. % aliasing effects.\n\
  244. \n\
  245. /EvenPixels {\n\
  246.     % Compute exact number of device pixels per stipple dot.\n\
  247.     dup 0 matrix currentmatrix dtransform\n\
  248.     dup mul exch dup mul add sqrt\n\
  249. \n\
  250.     % Round to an integer, make sure the number is at least 1, and compute\n\
  251.     % user coord distance corresponding to this.\n\
  252.     dup round dup 1 lt {pop 1} if\n\
  253.     exch div mul\n\
  254. } bind def\n\
  255. \n\
  256. % width height string StippleFill --\n\
  257. %\n\
  258. % Given a path already set up and a clipping region generated from\n\
  259. % it, this procedure will fill the clipping region with a stipple\n\
  260. % pattern.  \"String\" contains a proper image description of the\n\
  261. % stipple pattern and \"width\" and \"height\" give its dimensions.  Each\n\
  262. % stipple dot is assumed to be about one unit across in the current\n\
  263. % user coordinate system.  This procedure trashes the graphics state.\n\
  264. \n\
  265. /StippleFill {\n\
  266.     % The following code is needed to work around a NeWSprint bug.\n\
  267. \n\
  268.     /tmpstip 1 index def\n\
  269. \n\
  270.     % Change the scaling so that one user unit in user coordinates\n\
  271.     % corresponds to the size of one stipple dot.\n\
  272.     1 EvenPixels dup scale\n\
  273. \n\
  274.     % Compute the bounding box occupied by the path (which is now\n\
  275.     % the clipping region), and round the lower coordinates down\n\
  276.     % to the nearest starting point for the stipple pattern.  Be\n\
  277.     % careful about negative numbers, since the rounding works\n\
  278.     % differently on them.\n\
  279. \n\
  280.     pathbbox\n\
  281.     4 2 roll\n\
  282.     5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll\n\
  283.     6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll\n\
  284. \n\
  285.     % Stack now: width height string y1 y2 x1 x2\n\
  286.     % Below is a doubly-nested for loop to iterate across this area\n\
  287.     % in units of the stipple pattern size, going up columns then\n\
  288.     % acr",
  289.     /* End of part 3 */
  290.  
  291.     /* Start of part 4 (2000 characters) */
  292.     "oss rows, blasting out a stipple-pattern-sized rectangle at\n\
  293.     % each position\n\
  294. \n\
  295.     6 index exch {\n\
  296.     2 index 5 index 3 index {\n\
  297.         % Stack now: width height string y1 y2 x y\n\
  298. \n\
  299.         gsave\n\
  300.         1 index exch translate\n\
  301.         5 index 5 index true matrix tmpstip imagemask\n\
  302.         grestore\n\
  303.     } for\n\
  304.     pop\n\
  305.     } for\n\
  306.     pop pop pop pop pop\n\
  307. } bind def\n\
  308. \n\
  309. % -- AdjustColor --\n\
  310. % Given a color value already set for output by the caller, adjusts\n\
  311. % that value to a grayscale or mono value if requested by the CL\n\
  312. % variable.\n\
  313. \n\
  314. /AdjustColor {\n\
  315.     CL 2 lt {\n\
  316.     currentgray\n\
  317.     CL 0 eq {\n\
  318.         .5 lt {0} {1} ifelse\n\
  319.     } if\n\
  320.     setgray\n\
  321.     } if\n\
  322. } bind def\n\
  323. \n\
  324. % x y strings spacing xoffset yoffset justify stipple DrawText --\n\
  325. % This procedure does all of the real work of drawing text.  The\n\
  326. % color and font must already have been set by the caller, and the\n\
  327. % following arguments must be on the stack:\n\
  328. %\n\
  329. % x, y -    Coordinates at which to draw text.\n\
  330. % strings -    An array of strings, one for each line of the text item,\n\
  331. %        in order from top to bottom.\n\
  332. % spacing -    Spacing between lines.\n\
  333. % xoffset -    Horizontal offset for text bbox relative to x and y: 0 for\n\
  334. %        nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\
  335. % yoffset -    Vertical offset for text bbox relative to x and y: 0 for\n\
  336. %        nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\
  337. % justify -    0 for left justification, 0.5 for center, 1 for right justify.\n\
  338. % stipple -    Boolean value indicating whether or not text is to be\n\
  339. %        drawn in stippled fashion.  If text is stippled,\n\
  340. %        procedure StippleText must have been defined to call\n\
  341. %        StippleFill in the right way.\n\
  342. %\n\
  343. % Also, when this procedure is invoked, the color and font must already\n\
  344. % have been set for the text.\n\
  345. \n\
  346. /DrawText {\n\
  347.     /stipple exch def\n\
  348.     /justify exch def\n\
  349.     /yoffset exch def\n\
  350.     /xoffset exch def\n\
  351.     /spacing exch def\n\
  352.     /strings exch def\n\
  353. \n\
  354.     % First scan through all of the text to find the widest line.\n\
  355. \n\
  356.     /lineLength 0 def\n\
  357.     strings {\n\
  358.     stringwidth pop\n\
  359.     dup lineLength gt {/lineLength exch def}",
  360.     /* End of part 4 */
  361.  
  362.     /* Start of part 5 (1546 characters) */
  363.     " {pop} ifelse\n\
  364.     newpath\n\
  365.     } forall\n\
  366. \n\
  367.     % Compute the baseline offset and the actual font height.\n\
  368. \n\
  369.     0 0 moveto (TXygqPZ) false charpath\n\
  370.     pathbbox dup /baseline exch def\n\
  371.     exch pop exch sub /height exch def pop\n\
  372.     newpath\n\
  373. \n\
  374.     % Translate coordinates first so that the origin is at the upper-left\n\
  375.     % corner of the text's bounding box. Remember that x and y for\n\
  376.     % positioning are still on the stack.\n\
  377. \n\
  378.     translate\n\
  379.     lineLength xoffset mul\n\
  380.     strings length 1 sub spacing mul height add yoffset mul translate\n\
  381. \n\
  382.     % Now use the baseline and justification information to translate so\n\
  383.     % that the origin is at the baseline and positioning point for the\n\
  384.     % first line of text.\n\
  385. \n\
  386.     justify lineLength mul baseline neg translate\n\
  387. \n\
  388.     % Iterate over each of the lines to output it.  For each line,\n\
  389.     % compute its width again so it can be properly justified, then\n\
  390.     % display it.\n\
  391. \n\
  392.     strings {\n\
  393.     dup stringwidth pop\n\
  394.     justify neg mul 0 moveto\n\
  395.     stipple {\n\
  396. \n\
  397.         % The text is stippled, so turn it into a path and print\n\
  398.         % by calling StippledText, which in turn calls StippleFill.\n\
  399.         % Unfortunately, many Postscript interpreters will get\n\
  400.         % overflow errors if we try to do the whole string at\n\
  401.         % once, so do it a character at a time.\n\
  402. \n\
  403.         gsave\n\
  404.         /char (X) def\n\
  405.         {\n\
  406.         char 0 3 -1 roll put\n\
  407.         currentpoint\n\
  408.         gsave\n\
  409.         char true charpath clip StippleText\n\
  410.         grestore\n\
  411.         char stringwidth translate\n\
  412.         moveto\n\
  413.         } forall\n\
  414.         grestore\n\
  415.     } {show} ifelse\n\
  416.     0 spacing neg translate\n\
  417.     } forall\n\
  418. } bind def\n\
  419. \n\
  420. %%EndProlog\n\
  421. ",
  422.     /* End of part 5 */
  423.  
  424.     NULL    /* End of data marker */
  425. };
  426.  
  427. /*
  428.  * Forward declarations for procedures defined later in this file:
  429.  */
  430.  
  431. static int        GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
  432.                 char *string, double *doublePtr));
  433.  
  434. /*
  435.  *--------------------------------------------------------------
  436.  *
  437.  * TkCanvPostscriptCmd --
  438.  *
  439.  *    This procedure is invoked to process the "postscript" options
  440.  *    of the widget command for canvas widgets. See the user
  441.  *    documentation for details on what it does.
  442.  *
  443.  * Results:
  444.  *    A standard Tcl result.
  445.  *
  446.  * Side effects:
  447.  *    See the user documentation.
  448.  *
  449.  *--------------------------------------------------------------
  450.  */
  451.  
  452.     /* ARGSUSED */
  453. int
  454. TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
  455.     TkCanvas *canvasPtr;        /* Information about canvas widget. */
  456.     Tcl_Interp *interp;            /* Current interpreter. */
  457.     int argc;                /* Number of arguments. */
  458.     char **argv;            /* Argument strings.  Caller has
  459.                      * already parsed this command enough
  460.                      * to know that argv[1] is
  461.                      * "postscript". */
  462. {
  463.     TkPostscriptInfo psInfo, *oldInfoPtr;
  464.     int result;
  465.     Tk_Item *itemPtr;
  466. #define STRING_LENGTH 400
  467.     char string[STRING_LENGTH+1], *p;
  468.     time_t now;
  469.     size_t length;
  470.     int deltaX = 0, deltaY = 0;        /* Offset of lower-left corner of
  471.                      * area to be marked up, measured
  472.                      * in canvas units from the positioning
  473.                      * point on the page (reflects
  474.                      * anchor position).  Initial values
  475.                      * needed only to stop compiler
  476.                      * warnings. */
  477.     Tcl_HashSearch search;
  478.     Tcl_HashEntry *hPtr;
  479.     Tcl_DString buffer;
  480.     CONST char * CONST *chunk;
  481.  
  482.     /*
  483.      *----------------------------------------------------------------
  484.      * Initialize the data structure describing Postscript generation,
  485.      * then process all the arguments to fill the data structure in.
  486.      *----------------------------------------------------------------
  487.      */
  488.  
  489.     oldInfoPtr = canvasPtr->psInfoPtr;
  490.     canvasPtr->psInfoPtr = &psInfo;
  491.     psInfo.x = canvasPtr->xOrigin;
  492.     psInfo.y = canvasPtr->yOrigin;
  493.     psInfo.width = -1;
  494.     psInfo.height = -1;
  495.     psInfo.pageXString = NULL;
  496.     psInfo.pageYString = NULL;
  497.     psInfo.pageX = 72*4.25;
  498.     psInfo.pageY = 72*5.5;
  499.     psInfo.pageWidthString = NULL;
  500.     psInfo.pageHeightString = NULL;
  501.     psInfo.scale = 1.0;
  502.     psInfo.pageAnchor = TK_ANCHOR_CENTER;
  503.     psInfo.rotate = 0;
  504.     psInfo.fontVar = NULL;
  505.     psInfo.colorVar = NULL;
  506.     psInfo.colorMode = NULL;
  507.     psInfo.colorLevel = 0;
  508.     psInfo.fileName = NULL;
  509.     psInfo.channelName = NULL;
  510.     psInfo.chan = NULL;
  511.     psInfo.prepass = 0;
  512.     Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
  513.     result = Tk_ConfigureWidget(canvasPtr->interp, canvasPtr->tkwin,
  514.         configSpecs, argc-2, argv+2, (char *) &psInfo,
  515.         TK_CONFIG_ARGV_ONLY);
  516.     if (result != TCL_OK) {
  517.     goto cleanup;
  518.     }
  519.  
  520.     if (psInfo.width == -1) {
  521.     psInfo.width = Tk_Width(canvasPtr->tkwin);
  522.     }
  523.     if (psInfo.height == -1) {
  524.     psInfo.height = Tk_Height(canvasPtr->tkwin);
  525.     }
  526.     psInfo.x2 = psInfo.x + psInfo.width;
  527.     psInfo.y2 = psInfo.y + psInfo.height;
  528.  
  529.     if (psInfo.pageXString != NULL) {
  530.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageXString,
  531.         &psInfo.pageX) != TCL_OK) {
  532.         goto cleanup;
  533.     }
  534.     }
  535.     if (psInfo.pageYString != NULL) {
  536.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageYString,
  537.         &psInfo.pageY) != TCL_OK) {
  538.         goto cleanup;
  539.     }
  540.     }
  541.     if (psInfo.pageWidthString != NULL) {
  542.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageWidthString,
  543.         &psInfo.scale) != TCL_OK) {
  544.         goto cleanup;
  545.     }
  546.     psInfo.scale /= psInfo.width;
  547.     } else if (psInfo.pageHeightString != NULL) {
  548.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageHeightString,
  549.         &psInfo.scale) != TCL_OK) {
  550.         goto cleanup;
  551.     }
  552.     psInfo.scale /= psInfo.height;
  553.     } else {
  554.     psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(canvasPtr->tkwin));
  555.     psInfo.scale /= WidthOfScreen(Tk_Screen(canvasPtr->tkwin));
  556.     }
  557.     switch (psInfo.pageAnchor) {
  558.     case TK_ANCHOR_NW:
  559.     case TK_ANCHOR_W:
  560.     case TK_ANCHOR_SW:
  561.         deltaX = 0;
  562.         break;
  563.     case TK_ANCHOR_N:
  564.     case TK_ANCHOR_CENTER:
  565.     case TK_ANCHOR_S:
  566.         deltaX = -psInfo.width/2;
  567.         break;
  568.     case TK_ANCHOR_NE:
  569.     case TK_ANCHOR_E:
  570.     case TK_ANCHOR_SE:
  571.         deltaX = -psInfo.width;
  572.         break;
  573.     }
  574.     switch (psInfo.pageAnchor) {
  575.     case TK_ANCHOR_NW:
  576.     case TK_ANCHOR_N:
  577.     case TK_ANCHOR_NE:
  578.         deltaY = - psInfo.height;
  579.         break;
  580.     case TK_ANCHOR_W:
  581.     case TK_ANCHOR_CENTER:
  582.     case TK_ANCHOR_E:
  583.         deltaY = -psInfo.height/2;
  584.         break;
  585.     case TK_ANCHOR_SW:
  586.     case TK_ANCHOR_S:
  587.     case TK_ANCHOR_SE:
  588.         deltaY = 0;
  589.         break;
  590.     }
  591.  
  592.     if (psInfo.colorMode == NULL) {
  593.     psInfo.colorLevel = 2;
  594.     } else {
  595.     length = strlen(psInfo.colorMode);
  596.     if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
  597.         psInfo.colorLevel = 0;
  598.     } else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
  599.         psInfo.colorLevel = 1;
  600.     } else if (strncmp(psInfo.colorMode, "color", length) == 0) {
  601.         psInfo.colorLevel = 2;
  602.     } else {
  603.         Tcl_AppendResult(canvasPtr->interp, "bad color mode \"",
  604.             psInfo.colorMode, "\": must be monochrome, ",
  605.             "gray, or color", (char *) NULL);
  606.         goto cleanup;
  607.     }
  608.     }
  609.  
  610.     if (psInfo.fileName != NULL) {
  611.  
  612.         /*
  613.          * Check that -file and -channel are not both specified.
  614.          */
  615.  
  616.         if (psInfo.channelName != NULL) {
  617.             Tcl_AppendResult(canvasPtr->interp, "can't specify both -file",
  618.                     " and -channel", (char *) NULL);
  619.             result = TCL_ERROR;
  620.             goto cleanup;
  621.         }
  622.  
  623.         /*
  624.          * Check that we are not in a safe interpreter. If we are, disallow
  625.          * the -file specification.
  626.          */
  627.  
  628.         if (Tcl_IsSafe(canvasPtr->interp)) {
  629.             Tcl_AppendResult(canvasPtr->interp, "can't specify -file in a",
  630.                     " safe interpreter", (char *) NULL);
  631.             result = TCL_ERROR;
  632.             goto cleanup;
  633.         }
  634.         
  635.     p = Tcl_TranslateFileName(canvasPtr->interp, psInfo.fileName, &buffer);
  636.     if (p == NULL) {
  637.         goto cleanup;
  638.     }
  639.     psInfo.chan = Tcl_OpenFileChannel(canvasPtr->interp, p, "w", 0666);
  640.     Tcl_DStringFree(&buffer);
  641.     if (psInfo.chan == NULL) {
  642.         goto cleanup;
  643.     }
  644.     }
  645.  
  646.     if (psInfo.channelName != NULL) {
  647.         int mode;
  648.         
  649.         /*
  650.          * Check that the channel is found in this interpreter and that it
  651.          * is open for writing.
  652.          */
  653.  
  654.         psInfo.chan = Tcl_GetChannel(canvasPtr->interp, psInfo.channelName,
  655.                 &mode);
  656.         if (psInfo.chan == (Tcl_Channel) NULL) {
  657.             result = TCL_ERROR;
  658.             goto cleanup;
  659.         }
  660.         if ((mode & TCL_WRITABLE) == 0) {
  661.             Tcl_AppendResult(canvasPtr->interp, "channel \"",
  662.                     psInfo.channelName, "\" wasn't opened for writing",
  663.                     (char *) NULL);
  664.             result = TCL_ERROR;
  665.             goto cleanup;
  666.         }
  667.     }
  668.     
  669.     /*
  670.      *--------------------------------------------------------
  671.      * Make a pre-pass over all of the items, generating Postscript
  672.      * and then throwing it away.  The purpose of this pass is just
  673.      * to collect information about all the fonts in use, so that
  674.      * we can output font information in the proper form required
  675.      * by the Document Structuring Conventions.
  676.      *--------------------------------------------------------
  677.      */
  678.  
  679.     psInfo.prepass = 1;
  680.     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
  681.         itemPtr = itemPtr->nextPtr) {
  682.     if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
  683.         || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
  684.         continue;
  685.     }
  686.     if (itemPtr->typePtr->postscriptProc == NULL) {
  687.         continue;
  688.     }
  689.     result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
  690.         (Tk_Canvas) canvasPtr, itemPtr, 1);
  691.     Tcl_ResetResult(canvasPtr->interp);
  692.     if (result != TCL_OK) {
  693.         /*
  694.          * An error just occurred.  Just skip out of this loop.
  695.          * There's no need to report the error now;  it can be
  696.          * reported later (errors can happen later that don't
  697.          * happen now, so we still have to check for errors later
  698.          * anyway).
  699.          */
  700.         break;
  701.     }
  702.     }
  703.     psInfo.prepass = 0;
  704.  
  705.     /*
  706.      *--------------------------------------------------------
  707.      * Generate the header and prolog for the Postscript.
  708.      *--------------------------------------------------------
  709.      */
  710.  
  711.     Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
  712.         "%%Creator: Tk Canvas Widget\n", (char *) NULL);
  713. #if !(defined(__WIN32__) || defined(MAC_TCL) || defined(__OS2__))
  714.     if (!Tcl_IsSafe(interp)) {
  715.     struct passwd *pwPtr = getpwuid(getuid());
  716.     Tcl_AppendResult(canvasPtr->interp, "%%For: ",
  717.         (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
  718.         (char *) NULL);
  719.     endpwent();
  720.     }
  721. #endif /* __WIN32__ || MAC_TCL || __OS2__ */
  722.     Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ",
  723.         Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL);
  724.     time(&now);
  725.     Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ",
  726.         ctime(&now), (char *) NULL);
  727.     if (!psInfo.rotate) {
  728.     sprintf(string, "%d %d %d %d",
  729.         (int) (psInfo.pageX + psInfo.scale*deltaX),
  730.         (int) (psInfo.pageY + psInfo.scale*deltaY),
  731.         (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
  732.             + 1.0),
  733.         (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
  734.             + 1.0));
  735.     } else {
  736.     sprintf(string, "%d %d %d %d",
  737.         (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)),
  738.         (int) (psInfo.pageY + psInfo.scale*deltaX),
  739.         (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
  740.         (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
  741.             + 1.0));
  742.     }
  743.     Tcl_AppendResult(canvasPtr->interp, "%%BoundingBox: ", string,
  744.         "\n", (char *) NULL);
  745.     Tcl_AppendResult(canvasPtr->interp, "%%Pages: 1\n", 
  746.         "%%DocumentData: Clean7Bit\n", (char *) NULL);
  747.     Tcl_AppendResult(canvasPtr->interp, "%%Orientation: ",
  748.         psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL);
  749.     p = "%%DocumentNeededResources: font ";
  750.     for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
  751.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  752.     Tcl_AppendResult(canvasPtr->interp, p,
  753.         Tcl_GetHashKey(&psInfo.fontTable, hPtr),
  754.         "\n", (char *) NULL);
  755.     p = "%%+ font ";
  756.     }
  757.     Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL);
  758.  
  759.     /*
  760.      * Insert the prolog
  761.      */
  762.     for (chunk=prolog; *chunk; chunk++) {
  763.     Tcl_AppendResult(interp, *chunk, (char *) NULL);
  764.     }
  765.  
  766.     if (psInfo.chan != NULL) {
  767.     Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
  768.     Tcl_ResetResult(canvasPtr->interp);
  769.     }
  770.  
  771.     /*
  772.      *-----------------------------------------------------------
  773.      * Document setup:  set the color level and include fonts.
  774.      *-----------------------------------------------------------
  775.      */
  776.  
  777.     sprintf(string, "/CL %d def\n", psInfo.colorLevel);
  778.     Tcl_AppendResult(canvasPtr->interp, "%%BeginSetup\n", string,
  779.         (char *) NULL);
  780.     for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
  781.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  782.     Tcl_AppendResult(canvasPtr->interp, "%%IncludeResource: font ",
  783.         Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL);
  784.     }
  785.     Tcl_AppendResult(canvasPtr->interp, "%%EndSetup\n\n", (char *) NULL);
  786.  
  787.     /*
  788.      *-----------------------------------------------------------
  789.      * Page setup:  move to page positioning point, rotate if
  790.      * needed, set scale factor, offset for proper anchor position,
  791.      * and set clip region.
  792.      *-----------------------------------------------------------
  793.      */
  794.  
  795.     Tcl_AppendResult(canvasPtr->interp, "%%Page: 1 1\n", "save\n",
  796.         (char *) NULL);
  797.     sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
  798.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  799.     if (psInfo.rotate) {
  800.     Tcl_AppendResult(canvasPtr->interp, "90 rotate\n", (char *) NULL);
  801.     }
  802.     sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
  803.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  804.     sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
  805.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  806.     sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
  807.         psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
  808.         psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
  809.         psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2),
  810.         psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2));
  811.     Tcl_AppendResult(canvasPtr->interp, string,
  812.     " lineto closepath clip newpath\n", (char *) NULL);
  813.     if (psInfo.chan != NULL) {
  814.     Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
  815.     Tcl_ResetResult(canvasPtr->interp);
  816.     }
  817.  
  818.     /*
  819.      *---------------------------------------------------------------------
  820.      * Iterate through all the items, having each relevant one draw itself.
  821.      * Quit if any of the items returns an error.
  822.      *---------------------------------------------------------------------
  823.      */
  824.  
  825.     result = TCL_OK;
  826.     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
  827.         itemPtr = itemPtr->nextPtr) {
  828.     if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
  829.         || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
  830.         continue;
  831.     }
  832.     if (itemPtr->typePtr->postscriptProc == NULL) {
  833.         continue;
  834.     }
  835.     Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL);
  836.     result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
  837.         (Tk_Canvas) canvasPtr, itemPtr, 0);
  838.     if (result != TCL_OK) {
  839.         char msg[100];
  840.  
  841.         sprintf(msg, "\n    (generating Postscript for item %d)",
  842.             itemPtr->id);
  843.         Tcl_AddErrorInfo(canvasPtr->interp, msg);
  844.         goto cleanup;
  845.     }
  846.     Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL);
  847.     if (psInfo.chan != NULL) {
  848.         Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
  849.         Tcl_ResetResult(canvasPtr->interp);
  850.     }
  851.     }
  852.  
  853.     /*
  854.      *---------------------------------------------------------------------
  855.      * Output page-end information, such as commands to print the page
  856.      * and document trailer stuff.
  857.      *---------------------------------------------------------------------
  858.      */
  859.  
  860.     Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n",
  861.         "%%Trailer\nend\n%%EOF\n", (char *) NULL);
  862.     if (psInfo.chan != NULL) {
  863.     Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
  864.     Tcl_ResetResult(canvasPtr->interp);
  865.     }
  866.  
  867.     /*
  868.      * Clean up psInfo to release malloc'ed stuff.
  869.      */
  870.  
  871.     cleanup:
  872.     if (psInfo.pageXString != NULL) {
  873.     ckfree(psInfo.pageXString);
  874.     }
  875.     if (psInfo.pageYString != NULL) {
  876.     ckfree(psInfo.pageYString);
  877.     }
  878.     if (psInfo.pageWidthString != NULL) {
  879.     ckfree(psInfo.pageWidthString);
  880.     }
  881.     if (psInfo.pageHeightString != NULL) {
  882.     ckfree(psInfo.pageHeightString);
  883.     }
  884.     if (psInfo.fontVar != NULL) {
  885.     ckfree(psInfo.fontVar);
  886.     }
  887.     if (psInfo.colorVar != NULL) {
  888.     ckfree(psInfo.colorVar);
  889.     }
  890.     if (psInfo.colorMode != NULL) {
  891.     ckfree(psInfo.colorMode);
  892.     }
  893.     if (psInfo.fileName != NULL) {
  894.     ckfree(psInfo.fileName);
  895.     }
  896.     if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
  897.     Tcl_Close(canvasPtr->interp, psInfo.chan);
  898.     }
  899.     if (psInfo.channelName != NULL) {
  900.         ckfree(psInfo.channelName);
  901.     }
  902.     Tcl_DeleteHashTable(&psInfo.fontTable);
  903.     canvasPtr->psInfoPtr = oldInfoPtr;
  904.     return result;
  905. }
  906.  
  907. /*
  908.  *--------------------------------------------------------------
  909.  *
  910.  * Tk_CanvasPsColor --
  911.  *
  912.  *    This procedure is called by individual canvas items when
  913.  *    they want to set a color value for output.  Given information
  914.  *    about an X color, this procedure will generate Postscript
  915.  *    commands to set up an appropriate color in Postscript.
  916.  *
  917.  * Results:
  918.  *    Returns a standard Tcl return value.  If an error occurs
  919.  *    then an error message will be left in interp->result.
  920.  *    If no error occurs, then additional Postscript will be
  921.  *    appended to interp->result.
  922.  *
  923.  * Side effects:
  924.  *    None.
  925.  *
  926.  *--------------------------------------------------------------
  927.  */
  928.  
  929. int
  930. Tk_CanvasPsColor(interp, canvas, colorPtr)
  931.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  932.                      * or error message. */
  933.     Tk_Canvas canvas;            /* Information about canvas. */
  934.     XColor *colorPtr;            /* Information about color. */
  935. {
  936.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  937.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  938.     int tmp;
  939.     double red, green, blue;
  940.     char string[200];
  941.  
  942.     if (psInfoPtr->prepass) {
  943.     return TCL_OK;
  944.     }
  945.  
  946.     /*
  947.      * If there is a color map defined, then look up the color's name
  948.      * in the map and use the Postscript commands found there, if there
  949.      * are any.
  950.      */
  951.  
  952.     if (psInfoPtr->colorVar != NULL) {
  953.     char *cmdString;
  954.  
  955.     cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
  956.         Tk_NameOfColor(colorPtr), 0);
  957.     if (cmdString != NULL) {
  958.         Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
  959.         return TCL_OK;
  960.     }
  961.     }
  962.  
  963.     /*
  964.      * No color map entry for this color.  Grab the color's intensities
  965.      * and output Postscript commands for them.  Special note:  X uses
  966.      * a range of 0-65535 for intensities, but most displays only use
  967.      * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
  968.      * X scale.  This means that there's no way to get perfect white,
  969.      * since the highest intensity is only 65280 out of 65535.  To
  970.      * work around this problem, rescale the X intensity to a 0-255
  971.      * scale and use that as the basis for the Postscript colors.  This
  972.      * scheme still won't work if the display only uses 4 bits per color,
  973.      * but most diplays use at least 8 bits.
  974.      */
  975.  
  976.     tmp = colorPtr->red;
  977.     red = ((double) (tmp >> 8))/255.0;
  978.     tmp = colorPtr->green;
  979.     green = ((double) (tmp >> 8))/255.0;
  980.     tmp = colorPtr->blue;
  981.     blue = ((double) (tmp >> 8))/255.0;
  982.     sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
  983.         red, green, blue);
  984.     Tcl_AppendResult(interp, string, (char *) NULL);
  985.     return TCL_OK;
  986. }
  987.  
  988. /*
  989.  *--------------------------------------------------------------
  990.  *
  991.  * Tk_CanvasPsFont --
  992.  *
  993.  *    This procedure is called by individual canvas items when
  994.  *    they want to output text.  Given information about an X
  995.  *    font, this procedure will generate Postscript commands
  996.  *    to set up an appropriate font in Postscript.
  997.  *
  998.  * Results:
  999.  *    Returns a standard Tcl return value.  If an error occurs
  1000.  *    then an error message will be left in interp->result.
  1001.  *    If no error occurs, then additional Postscript will be
  1002.  *    appended to the interp->result.
  1003.  *
  1004.  * Side effects:
  1005.  *    The Postscript font name is entered into psInfoPtr->fontTable
  1006.  *    if it wasn't already there.
  1007.  *
  1008.  *--------------------------------------------------------------
  1009.  */
  1010.  
  1011. int
  1012. Tk_CanvasPsFont(interp, canvas, tkfont)
  1013.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  1014.                      * or error message. */
  1015.     Tk_Canvas canvas;            /* Information about canvas. */
  1016.     Tk_Font tkfont;            /* Information about font in which text
  1017.                      * is to be printed. */
  1018. {
  1019.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  1020.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  1021.     char *end;
  1022.     char pointString[20];
  1023.     Tcl_DString ds;
  1024.     int i, points;
  1025.  
  1026.     /*
  1027.      * First, look up the font's name in the font map, if there is one.
  1028.      * If there is an entry for this font, it consists of a list
  1029.      * containing font name and size.  Use this information.
  1030.      */
  1031.  
  1032.     Tcl_DStringInit(&ds);
  1033.     
  1034.     if (psInfoPtr->fontVar != NULL) {
  1035.     char *list, **argv;
  1036.     int argc;
  1037.     double size;
  1038.     char *name;
  1039.  
  1040.     name = Tk_NameOfFont(tkfont);
  1041.     list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
  1042.     if (list != NULL) {
  1043.         if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) {
  1044.         badMapEntry:
  1045.         Tcl_ResetResult(interp);
  1046.         Tcl_AppendResult(interp, "bad font map entry for \"", name,
  1047.             "\": \"", list, "\"", (char *) NULL);
  1048.         return TCL_ERROR;
  1049.         }
  1050.         if (argc != 2) {
  1051.         goto badMapEntry;
  1052.         }
  1053.         size = strtod(argv[1], &end);
  1054.         if ((size <= 0) || (*end != 0)) {
  1055.         goto badMapEntry;
  1056.         }
  1057.  
  1058.         Tcl_DStringAppend(&ds, argv[0], -1);
  1059.         points = (int) size;
  1060.         
  1061.         ckfree((char *) argv);
  1062.         goto findfont;
  1063.     }
  1064.     } 
  1065.  
  1066.     points = Tk_PostscriptFontName(tkfont, &ds);
  1067.  
  1068.     findfont:
  1069.     sprintf(pointString, "%d", points);
  1070.     Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ",
  1071.         pointString, " scalefont ", (char *) NULL);
  1072.     if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) {
  1073.     Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL);
  1074.     }
  1075.     Tcl_AppendResult(interp, "setfont\n", (char *) NULL);
  1076.     Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
  1077.     Tcl_DStringFree(&ds);
  1078.  
  1079.     return TCL_OK;
  1080. }
  1081.  
  1082. /*
  1083.  *--------------------------------------------------------------
  1084.  *
  1085.  * Tk_CanvasPsBitmap --
  1086.  *
  1087.  *    This procedure is called to output the contents of a
  1088.  *    sub-region of a bitmap in proper image data format for
  1089.  *    Postscript (i.e. data between angle brackets, one bit
  1090.  *    per pixel).
  1091.  *
  1092.  * Results:
  1093.  *    Returns a standard Tcl return value.  If an error occurs
  1094.  *    then an error message will be left in interp->result.
  1095.  *    If no error occurs, then additional Postscript will be
  1096.  *    appended to interp->result.
  1097.  *
  1098.  * Side effects:
  1099.  *    None.
  1100.  *
  1101.  *--------------------------------------------------------------
  1102.  */
  1103.  
  1104. int
  1105. Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
  1106.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  1107.                      * or error message. */
  1108.     Tk_Canvas canvas;            /* Information about canvas. */
  1109.     Pixmap bitmap;            /* Bitmap for which to generate
  1110.                      * Postscript. */
  1111.     int startX, startY;            /* Coordinates of upper-left corner
  1112.                      * of rectangular region to output. */
  1113.     int width, height;            /* Height of rectangular region. */
  1114. {
  1115.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  1116.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  1117.     XImage *imagePtr;
  1118.     int charsInLine, x, y, lastX, lastY, value, mask;
  1119.     unsigned int totalWidth, totalHeight;
  1120.     char string[100];
  1121.     Window dummyRoot;
  1122.     int dummyX, dummyY;
  1123.     unsigned dummyBorderwidth, dummyDepth;
  1124.  
  1125.     if (psInfoPtr->prepass) {
  1126.     return TCL_OK;
  1127.     }
  1128.  
  1129.     /*
  1130.      * The following call should probably be a call to Tk_SizeOfBitmap
  1131.      * instead, but it seems that we are occasionally invoked by custom
  1132.      * item types that create their own bitmaps without registering them
  1133.      * with Tk.  XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
  1134.      * it shouldn't matter here.
  1135.      */
  1136.  
  1137.     XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
  1138.         (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
  1139.         (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
  1140.     imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0,
  1141.         totalWidth, totalHeight, 1, XYPixmap);
  1142.     Tcl_AppendResult(interp, "<", (char *) NULL);
  1143.     mask = 0x80;
  1144.     value = 0;
  1145.     charsInLine = 0;
  1146.     lastX = startX + width - 1;
  1147.     lastY = startY + height - 1;
  1148.     for (y = lastY; y >= startY; y--) {
  1149.     for (x = startX; x <= lastX; x++) {
  1150.         if (XGetPixel(imagePtr, x, y)) {
  1151.         value |= mask;
  1152.         }
  1153.         mask >>= 1;
  1154.         if (mask == 0) {
  1155.         sprintf(string, "%02x", value);
  1156.         Tcl_AppendResult(interp, string, (char *) NULL);
  1157.         mask = 0x80;
  1158.         value = 0;
  1159.         charsInLine += 2;
  1160.         if (charsInLine >= 60) {
  1161.             Tcl_AppendResult(interp, "\n", (char *) NULL);
  1162.             charsInLine = 0;
  1163.         }
  1164.         }
  1165.     }
  1166.     if (mask != 0x80) {
  1167.         sprintf(string, "%02x", value);
  1168.         Tcl_AppendResult(interp, string, (char *) NULL);
  1169.         mask = 0x80;
  1170.         value = 0;
  1171.         charsInLine += 2;
  1172.     }
  1173.     }
  1174.     Tcl_AppendResult(interp, ">", (char *) NULL);
  1175.     XDestroyImage(imagePtr);
  1176.     return TCL_OK;
  1177. }
  1178.  
  1179. /*
  1180.  *--------------------------------------------------------------
  1181.  *
  1182.  * Tk_CanvasPsStipple --
  1183.  *
  1184.  *    This procedure is called by individual canvas items when
  1185.  *    they have created a path that they'd like to be filled with
  1186.  *    a stipple pattern.  Given information about an X bitmap,
  1187.  *    this procedure will generate Postscript commands to fill
  1188.  *    the current clip region using a stipple pattern defined by the
  1189.  *    bitmap.
  1190.  *
  1191.  * Results:
  1192.  *    Returns a standard Tcl return value.  If an error occurs
  1193.  *    then an error message will be left in interp->result.
  1194.  *    If no error occurs, then additional Postscript will be
  1195.  *    appended to interp->result.
  1196.  *
  1197.  * Side effects:
  1198.  *    None.
  1199.  *
  1200.  *--------------------------------------------------------------
  1201.  */
  1202.  
  1203. int
  1204. Tk_CanvasPsStipple(interp, canvas, bitmap)
  1205.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  1206.                      * or error message. */
  1207.     Tk_Canvas canvas;            /* Information about canvas. */
  1208.     Pixmap bitmap;            /* Bitmap to use for stippling. */
  1209. {
  1210.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  1211.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  1212.     int width, height;
  1213.     char string[100];
  1214.     Window dummyRoot;
  1215.     int dummyX, dummyY;
  1216.     unsigned dummyBorderwidth, dummyDepth;
  1217.  
  1218.     if (psInfoPtr->prepass) {
  1219.     return TCL_OK;
  1220.     }
  1221.  
  1222.     /*
  1223.      * The following call should probably be a call to Tk_SizeOfBitmap
  1224.      * instead, but it seems that we are occasionally invoked by custom
  1225.      * item types that create their own bitmaps without registering them
  1226.      * with Tk.  XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
  1227.      * it shouldn't matter here.
  1228.      */
  1229.  
  1230.     XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
  1231.         (int *) &dummyX, (int *) &dummyY, (unsigned *) &width,
  1232.         (unsigned *) &height, &dummyBorderwidth, &dummyDepth);
  1233.     sprintf(string, "%d %d ", width, height);
  1234.     Tcl_AppendResult(interp, string, (char *) NULL);
  1235.     if (Tk_CanvasPsBitmap(interp, (Tk_Canvas) canvasPtr, bitmap, 0, 0,
  1236.         width, height) != TCL_OK) {
  1237.     return TCL_ERROR;
  1238.     }
  1239.     Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
  1240.     return TCL_OK;
  1241. }
  1242.  
  1243. /*
  1244.  *--------------------------------------------------------------
  1245.  *
  1246.  * Tk_CanvasPsY --
  1247.  *
  1248.  *    Given a y-coordinate in canvas coordinates, this procedure
  1249.  *    returns a y-coordinate to use for Postscript output.
  1250.  *
  1251.  * Results:
  1252.  *    Returns the Postscript coordinate that corresponds to
  1253.  *    "y".
  1254.  *
  1255.  * Side effects:
  1256.  *    None.
  1257.  *
  1258.  *--------------------------------------------------------------
  1259.  */
  1260.  
  1261. double
  1262. Tk_CanvasPsY(canvas, y)
  1263.     Tk_Canvas canvas;            /* Token for canvas on whose behalf
  1264.                      * Postscript is being generated. */
  1265.     double y;                /* Y-coordinate in canvas coords. */
  1266. {
  1267.     TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
  1268.  
  1269.     return psInfoPtr->y2 - y;
  1270. }
  1271.  
  1272. /*
  1273.  *--------------------------------------------------------------
  1274.  *
  1275.  * Tk_CanvasPsPath --
  1276.  *
  1277.  *    Given an array of points for a path, generate Postscript
  1278.  *    commands to create the path.
  1279.  *
  1280.  * Results:
  1281.  *    Postscript commands get appended to what's in interp->result.
  1282.  *
  1283.  * Side effects:
  1284.  *    None.
  1285.  *
  1286.  *--------------------------------------------------------------
  1287.  */
  1288.  
  1289. void
  1290. Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
  1291.     Tcl_Interp *interp;            /* Put generated Postscript in this
  1292.                      * interpreter's result field. */
  1293.     Tk_Canvas canvas;            /* Canvas on whose behalf Postscript
  1294.                      * is being generated. */
  1295.     double *coordPtr;            /* Pointer to first in array of
  1296.                      * 2*numPoints coordinates giving
  1297.                      * points for path. */
  1298.     int numPoints;            /* Number of points at *coordPtr. */
  1299. {
  1300.     TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
  1301.     char buffer[200];
  1302.  
  1303.     if (psInfoPtr->prepass) {
  1304.     return;
  1305.     }
  1306.     sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
  1307.         Tk_CanvasPsY(canvas, coordPtr[1]));
  1308.     Tcl_AppendResult(interp, buffer, (char *) NULL);
  1309.     for (numPoints--, coordPtr += 2; numPoints > 0;
  1310.         numPoints--, coordPtr += 2) {
  1311.     sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0],
  1312.         Tk_CanvasPsY(canvas, coordPtr[1]));
  1313.     Tcl_AppendResult(interp, buffer, (char *) NULL);
  1314.     }
  1315. }
  1316.  
  1317. /*
  1318.  *--------------------------------------------------------------
  1319.  *
  1320.  * GetPostscriptPoints --
  1321.  *
  1322.  *    Given a string, returns the number of Postscript points
  1323.  *    corresponding to that string.
  1324.  *
  1325.  * Results:
  1326.  *    The return value is a standard Tcl return result.  If
  1327.  *    TCL_OK is returned, then everything went well and the
  1328.  *    screen distance is stored at *doublePtr;  otherwise
  1329.  *    TCL_ERROR is returned and an error message is left in
  1330.  *    interp->result.
  1331.  *
  1332.  * Side effects:
  1333.  *    None.
  1334.  *
  1335.  *--------------------------------------------------------------
  1336.  */
  1337.  
  1338. static int
  1339. GetPostscriptPoints(interp, string, doublePtr)
  1340.     Tcl_Interp *interp;        /* Use this for error reporting. */
  1341.     char *string;        /* String describing a screen distance. */
  1342.     double *doublePtr;        /* Place to store converted result. */
  1343. {
  1344.     char *end;
  1345.     double d;
  1346.  
  1347.     d = strtod(string, &end);
  1348.     if (end == string) {
  1349.     error:
  1350.     Tcl_AppendResult(interp, "bad distance \"", string,
  1351.         "\"", (char *) NULL);
  1352.     return TCL_ERROR;
  1353.     }
  1354.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  1355.     end++;
  1356.     }
  1357.     switch (*end) {
  1358.     case 'c':
  1359.         d *= 72.0/2.54;
  1360.         end++;
  1361.         break;
  1362.     case 'i':
  1363.         d *= 72.0;
  1364.         end++;
  1365.         break;
  1366.     case 'm':
  1367.         d *= 72.0/25.4;
  1368.         end++;
  1369.         break;
  1370.     case 0:
  1371.         break;
  1372.     case 'p':
  1373.         end++;
  1374.         break;
  1375.     default:
  1376.         goto error;
  1377.     }
  1378.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  1379.     end++;
  1380.     }
  1381.     if (*end != 0) {
  1382.     goto error;
  1383.     }
  1384.     *doublePtr = d;
  1385.     return TCL_OK;
  1386. }
  1387.