home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / maths / plplot / plplot_2 / drivers / tk / tk.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-08-25  |  44.1 KB  |  1,728 lines
  1. /* $Id: tk.c,v 1.45 1994/08/25 04:02:03 mjl Exp $
  2.  * $Log: tk.c,v $
  3.  * Revision 1.45  1994/08/25  04:02:03  mjl
  4.  * Fix to allow a TK main window to be associated with each PLStream.
  5.  * Contributed by Radey Shouman.
  6.  *
  7.  * Revision 1.44  1994/07/25  06:44:25  mjl
  8.  * Wrapped the include of unistd.h in a HAVE_UNISTD_H.
  9.  *
  10.  * Revision 1.43  1994/07/23  04:45:42  mjl
  11.  * Added code to start plserver with sigprocmask set so that a ^C doesn't
  12.  * kill it (enabled if pls->server_nokill is set).  Contributed by Ian
  13.  * Searle.
  14.  *
  15.  * Revision 1.42  1994/07/22  10:17:48  mjl
  16.  * Bug squashed, introduced in last update.  On issuing a "Q", the cleanup
  17.  * was getting hosed, leaving a spurious plserver window hanging around.
  18.  * Works great now.
  19.  *
  20.  * Revision 1.41  1994/07/21  08:43:27  mjl
  21.  * Eliminated some bogus Tcl-DP initializations when the Tk driver is
  22.  * being used.
  23.  *
  24.  * Revision 1.40  1994/07/19  22:31:48  mjl
  25.  * All device drivers: enabling macro renamed to PLD_<driver>, where <driver>
  26.  * is xwin, ps, etc.  See plDevs.h for more detail.  All internal header file
  27.  * inclusion changed to /not/ use a search path so that it will work better
  28.  * with makedepend.
  29.  *
  30.  * Revision 1.39  1994/07/18  20:30:39  mjl
  31.  * Fixed the eop driver function to flush output even if pause is turned off.
  32. */
  33.  
  34. /*    tk.c
  35.  *
  36.  *    Maurice LeBrun
  37.  *    30-Apr-93
  38.  *
  39.  *    PLPLOT Tcl/Tk and Tcl-DP device drivers.
  40.  *    Should be broken up somewhat better to prepare for DP w/o X.
  41.  */
  42.  
  43. /*
  44. #define DEBUG_ENTER
  45. #define DEBUG
  46. */
  47.  
  48. #include "plDevs.h"
  49.  
  50. #ifdef PLD_tk
  51.  
  52. #include "plplotP.h"
  53. #include "plplotTK.h"
  54. #include "plplotX.h"
  55. #include "pltcl.h"
  56. #include "drivers.h"
  57. #include "metadefs.h"
  58. #include "plevent.h"
  59.  
  60. #ifdef HAVE_UNISTD_H
  61. #include <unistd.h>
  62. #endif
  63. #include <sys/stat.h>
  64. #include <fcntl.h>
  65. #include <errno.h>
  66. #include <signal.h>
  67.  
  68. #ifdef PLD_dp
  69. #include <dp.h>
  70. #endif
  71.  
  72. /* A handy command wrapper */
  73.  
  74. #define tk_wr(code) \
  75. if (code) { abort_session(pls, "Unable to write to PDFstrm"); }
  76.  
  77. /*----------------------------------------------------------------------*/
  78. /* Function prototypes */
  79.  
  80. /* various */
  81.  
  82. static void    init        (PLStream *pls);
  83. static void    tk_start    (PLStream *pls);
  84. static void    tk_stop        (PLStream *pls);
  85. static void    tk_di        (PLStream *pls);
  86. static void    tk_fill        (PLStream *pls);
  87. static void    WaitForPage    (PLStream *pls);
  88. static void    HandleEvents    (PLStream *pls);
  89. static void    init_server    (PLStream *pls);
  90. static void    launch_server    (PLStream *pls);
  91. static void    flush_output    (PLStream *pls);
  92. static void    plwindow_init    (PLStream *pls);
  93. static void    link_init    (PLStream *pls);
  94.  
  95. /* performs Tk-driver-specific initialization */
  96.  
  97. static int    pltkdriver_Init    (PLStream *pls);
  98.  
  99. /* Tcl/TK utility commands */
  100.  
  101. static void    tk_wait        (PLStream *pls, char *);
  102. static void    abort_session    (PLStream *pls, char *);
  103. static void    server_cmd    (PLStream *pls, char *, int);
  104. static void    tcl_cmd        (PLStream *pls, char *);
  105. static void    copybuf        (PLStream *pls, char *cmd);
  106. static int    pltk_toplevel    (Tk_Window *w, Tcl_Interp *interp,
  107.                  char *display, char *basename,
  108.                  char *classname);
  109.  
  110. /* These are internal TCL commands */
  111.  
  112. static int    Abort        (ClientData, Tcl_Interp *, int, char **);
  113. static int    KeyEH        (ClientData, Tcl_Interp *, int, char **);
  114. static int    MouseEH        (ClientData, Tcl_Interp *, int, char **);
  115.  
  116. /*----------------------------------------------------------------------*\
  117.  * plD_init_dp()
  118.  * plD_init_tk()
  119.  * init_tk()
  120.  *
  121.  * Initialize device.
  122.  * TK-dependent stuff done in tk_start().  You can set the display by
  123.  * calling plsfnam() with the display name as the (string) argument.
  124. \*----------------------------------------------------------------------*/
  125.  
  126. void
  127. plD_init_tk(PLStream *pls)
  128. {
  129.     pls->dp = 0;
  130.     init(pls);
  131. }
  132.  
  133. void
  134. plD_init_dp(PLStream *pls)
  135. {
  136. #ifdef PLD_dp
  137.     pls->dp = 1;
  138. #else
  139.     fprintf(stderr, "The Tcl-DP driver hasn't been installed!\n");
  140.     pls->dp = 0;
  141. #endif
  142.     init(pls);
  143. }
  144.  
  145. static void
  146. tk_wr_header(PLStream *pls, char *header)
  147. {
  148.     tk_wr( pdf_wr_header(pls->pdfs, header) );
  149. }
  150.  
  151. static void
  152. init(PLStream *pls)
  153. {
  154.     U_CHAR c = (U_CHAR) INITIALIZE;
  155.     TkDev *dev;
  156.     int xmin = 0;
  157.     int xmax = PIXELS_X - 1;
  158.     int ymin = 0;
  159.     int ymax = PIXELS_Y - 1;
  160.  
  161.     float pxlx = (double) PIXELS_X / (double) LPAGE_X;
  162.     float pxly = (double) PIXELS_Y / (double) LPAGE_Y;
  163.  
  164.     dbug_enter("plD_init_tk");
  165.  
  166.     pls->termin = 1;        /* is an interactive terminal */
  167.     pls->icol0 = 1;
  168.     pls->width = 1;
  169.     pls->page = 0;
  170.     pls->dev_di = 1;
  171.     pls->dev_flush = 1;        /* Want to handle our own flushes */
  172.     pls->dev_fill0 = 1;
  173.     pls->dev_fill1 = 1;
  174.  
  175. /* Specify buffer size if not yet set (can be changed by -bufmax option).  */
  176. /* A small buffer works best for socket communication */
  177.  
  178.     if (pls->bufmax == 0) {
  179.     if (pls->dp)
  180.         pls->bufmax = 450;
  181.     else
  182.         pls->bufmax = 3500;
  183.     }
  184.  
  185. /* Allocate and initialize device-specific data */
  186.  
  187.     if (pls->dev != NULL)
  188.     free((void *) pls->dev);
  189.  
  190.     pls->dev = calloc(1, (size_t) sizeof(TkDev));
  191.     if (pls->dev == NULL)
  192.     plexit("plD_init_tk: Out of memory.");
  193.  
  194.     dev = (TkDev *) pls->dev;
  195.  
  196.     dev->iodev = (PLiodev *) calloc(1, (size_t) sizeof(PLiodev));
  197.     if (dev->iodev == NULL)
  198.     plexit("plD_init_tk: Out of memory.");
  199.  
  200.     dev->exit_eventloop = 0;
  201.  
  202. /* Start interpreter and spawn server process */
  203.  
  204.     tk_start(pls);
  205.  
  206. /* Get ready for plotting */
  207.  
  208.     dev->xold = UNDEFINED;
  209.     dev->yold = UNDEFINED;
  210.  
  211.     plP_setpxl(pxlx, pxly);
  212.     plP_setphy(xmin, xmax, ymin, ymax);
  213.  
  214. /* Send init info */
  215.  
  216.     tk_wr( pdf_wr_1byte(pls->pdfs, c) );
  217.  
  218. /* The header and version fields will be useful when the client & server */
  219. /* reside on different machines */
  220.  
  221.     tk_wr_header(pls, PLSERV_HEADER);
  222.     tk_wr_header(pls, PLSERV_VERSION);
  223.  
  224.     tk_wr_header(pls, "xmin");
  225.     tk_wr( pdf_wr_2bytes(pls->pdfs, (U_SHORT) xmin) );
  226.  
  227.     tk_wr_header(pls, "xmax");
  228.     tk_wr( pdf_wr_2bytes(pls->pdfs, (U_SHORT) xmax) );
  229.  
  230.     tk_wr_header(pls, "ymin");
  231.     tk_wr( pdf_wr_2bytes(pls->pdfs, (U_SHORT) ymin) );
  232.  
  233.     tk_wr_header(pls, "ymax");
  234.     tk_wr( pdf_wr_2bytes(pls->pdfs, (U_SHORT) ymax) );
  235.  
  236.     tk_wr_header(pls, "");
  237.  
  238. /* Write color map state info */
  239. /*
  240.     plD_state_plm(pls, PLSTATE_CMAP0);
  241.     plD_state_plm(pls, PLSTATE_CMAP1);
  242.     */
  243.  
  244. /* Good place to make sure the data transfer is working OK */
  245.  
  246.     flush_output(pls);
  247. }
  248.  
  249. /*----------------------------------------------------------------------*\
  250.  * plD_line_tk()
  251.  *
  252.  * Draw a line in the current color from (x1,y1) to (x2,y2).
  253. \*----------------------------------------------------------------------*/
  254.  
  255. void
  256. plD_line_tk(PLStream *pls, short x1, short y1, short x2, short y2)
  257. {
  258.     U_CHAR c;
  259.     U_SHORT xy[4];
  260.     static long count = 0, max_count = 100;
  261.     TkDev *dev = (TkDev *) pls->dev;
  262.  
  263.     if ( ++count/max_count >= 1 ) {
  264.     count = 0;
  265.     HandleEvents(pls);    /* Check for events */
  266.     }
  267.  
  268.     if (x1 == dev->xold && y1 == dev->yold) {
  269.     c = (U_CHAR) LINETO;
  270.     tk_wr( pdf_wr_1byte(pls->pdfs, c) );
  271.  
  272.     xy[0] = x2;
  273.     xy[1] = y2;
  274.     tk_wr( pdf_wr_2nbytes(pls->pdfs, xy, 2) );
  275.     }
  276.     else {
  277.     c = (U_CHAR) LINE;
  278.     tk_wr( pdf_wr_1byte(pls->pdfs, c) );
  279.  
  280.     xy[0] = x1;
  281.     xy[1] = y1;
  282.     xy[2] = x2;
  283.     xy[3] = y2;
  284.     tk_wr( pdf_wr_2nbytes(pls->pdfs, xy, 4) );
  285.     }
  286.     dev->xold = x2;
  287.     dev->yold = y2;
  288.  
  289.     if (pls->pdfs->bp > pls->bufmax)
  290.     flush_output(pls);
  291. }
  292.  
  293. /*----------------------------------------------------------------------*\
  294.  * plD_polyline_tk()
  295.  *
  296.  * Draw a polyline in the current color from (x1,y1) to (x2,y2).
  297. \*----------------------------------------------------------------------*/
  298.  
  299. void
  300. plD_polyline_tk(PLStream *pls, short *xa, short *ya, PLINT npts)
  301. {
  302.     U_CHAR c = (U_CHAR) POLYLINE;
  303.     static long count = 0, max_count = 100;
  304.     TkDev *dev = (TkDev *) pls->dev;
  305.  
  306.     if ( ++count/max_count >= 1 ) {
  307.     count = 0;
  308.     HandleEvents(pls);    /* Check for events */
  309.     }
  310.  
  311.     tk_wr( pdf_wr_1byte(pls->pdfs, c) );
  312.     tk_wr( pdf_wr_2bytes(pls->pdfs, (U_SHORT) npts) );
  313.  
  314.     tk_wr( pdf_wr_2nbytes(pls->pdfs, (U_SHORT *) xa, npts) );
  315.     tk_wr( pdf_wr_2nbytes(pls->pdfs, (U_SHORT *) ya, npts) );
  316.  
  317.     dev->xold = xa[npts - 1];
  318.     dev->yold = ya[npts - 1];
  319.  
  320.     if (pls->pdfs->bp > pls->bufmax)
  321.     flush_output(pls);
  322. }
  323.  
  324. /*----------------------------------------------------------------------*\
  325.  * plD_eop_tk()
  326.  *
  327.  * End of page.  
  328.  * User must hit <RETURN> to continue.
  329. \*----------------------------------------------------------------------*/
  330.  
  331. void
  332. plD_eop_tk(PLStream *pls)
  333. {
  334.     U_CHAR c = (U_CHAR) EOP;
  335.  
  336.     dbug_enter("plD_eop_tk");
  337.  
  338.     tk_wr( pdf_wr_1byte(pls->pdfs, c) );
  339.  
  340.     if (pls->pdfs->bp > 0) 
  341.     flush_output(pls);
  342.  
  343.     if ( ! pls->nopause)
  344.     WaitForPage(pls);
  345. }
  346.  
  347. /*----------------------------------------------------------------------*\
  348.  * plD_bop_tk()
  349.  *
  350.  * Set up for the next page.
  351. \*----------------------------------------------------------------------*/
  352.  
  353. void
  354. plD_bop_tk(PLStream *pls)
  355. {
  356.     U_CHAR c = (U_CHAR) BOP;
  357.     TkDev *dev = (TkDev *) pls->dev;
  358.  
  359.     dbug_enter("plD_bop_tk");
  360.  
  361.     dev->xold = UNDEFINED;
  362.     dev->yold = UNDEFINED;
  363.     pls->page++;
  364.     tk_wr( pdf_wr_1byte(pls->pdfs, c) );
  365. }
  366.  
  367. /*----------------------------------------------------------------------*\
  368.  * plD_tidy_tk()
  369.  *
  370.  * Close graphics file
  371. \*----------------------------------------------------------------------*/
  372.  
  373. void
  374. plD_tidy_tk(PLStream *pls)
  375. {
  376.     TkDev *dev = (TkDev *) pls->dev;
  377.  
  378.     dbug_enter("plD_tidy_tk");
  379.  
  380.     tk_stop(pls);
  381.     free_mem(dev->cmdbuf);
  382. }
  383.  
  384. /*----------------------------------------------------------------------*\
  385.  * plD_state_tk()
  386.  *
  387.  * Handle change in PLStream state (color, pen width, fill attribute, etc).
  388. \*----------------------------------------------------------------------*/
  389.  
  390. void 
  391. plD_state_tk(PLStream *pls, PLINT op)
  392. {
  393.     U_CHAR c = (U_CHAR) CHANGE_STATE;
  394.     int i;
  395.  
  396.     dbug_enter("plD_state_tk");
  397.  
  398.     tk_wr( pdf_wr_1byte(pls->pdfs, c) );
  399.     tk_wr( pdf_wr_1byte(pls->pdfs, op) );
  400.  
  401.     switch (op) {
  402.  
  403.     case PLSTATE_WIDTH:
  404.     tk_wr( pdf_wr_2bytes(pls->pdfs, (U_SHORT) (pls->width)) );
  405.     break;
  406.  
  407.     case PLSTATE_COLOR0:
  408.     tk_wr( pdf_wr_1byte(pls->pdfs, (U_CHAR) pls->icol0) );
  409.     if (pls->icol0 == PL_RGB_COLOR) {
  410.         tk_wr( pdf_wr_1byte(pls->pdfs, pls->curcolor.r) );
  411.         tk_wr( pdf_wr_1byte(pls->pdfs, pls->curcolor.g) );
  412.         tk_wr( pdf_wr_1byte(pls->pdfs, pls->curcolor.b) );
  413.     }
  414.     break;
  415.  
  416.     case PLSTATE_COLOR1:
  417.     tk_wr( pdf_wr_2bytes(pls->pdfs, (U_SHORT) pls->icol1) );
  418.     break;
  419.  
  420.     case PLSTATE_FILL:
  421.     tk_wr( pdf_wr_1byte(pls->pdfs, (U_CHAR) pls->patt) );
  422.     break;
  423.  
  424.     case PLSTATE_CMAP0:
  425.     tk_wr( pdf_wr_1byte(pls->pdfs, (U_CHAR) pls->ncol0) );
  426.     for (i = 0; i < pls->ncol0; i++) {
  427.         tk_wr( pdf_wr_1byte(pls->pdfs, pls->cmap0[i].r) );
  428.         tk_wr( pdf_wr_1byte(pls->pdfs, pls->cmap0[i].g) );
  429.         tk_wr( pdf_wr_1byte(pls->pdfs, pls->cmap0[i].b) );
  430.     }
  431.     break;
  432.  
  433.     case PLSTATE_CMAP1:
  434.     tk_wr( pdf_wr_2bytes(pls->pdfs, (U_SHORT) pls->ncol1) );
  435.     for (i = 0; i < pls->ncol1; i++) {
  436.         tk_wr( pdf_wr_1byte(pls->pdfs, pls->cmap1[i].r) );
  437.         tk_wr( pdf_wr_1byte(pls->pdfs, pls->cmap1[i].g) );
  438.         tk_wr( pdf_wr_1byte(pls->pdfs, pls->cmap1[i].b) );
  439.     }
  440.     break;
  441.     }
  442.  
  443.     if (pls->pdfs->bp > pls->bufmax)
  444.     flush_output(pls);
  445. }
  446.  
  447. /*----------------------------------------------------------------------*\
  448.  * plD_esc_tk()
  449.  *
  450.  * Escape function.
  451.  * Functions:
  452.  *
  453.  *    PLESC_EXPOSE    Force an expose (just passes token)
  454.  *    PLESC_RESIZE    Force a resize (just passes token)
  455.  *    PLESC_REDRAW    Force a redraw
  456.  *    PLESC_FLUSH    Flush X event buffer
  457.  *    PLESC_FILL    Fill polygon
  458.  *    PLESC_EH    Handle events only
  459.  *
  460. \*----------------------------------------------------------------------*/
  461.  
  462. void
  463. plD_esc_tk(PLStream *pls, PLINT op, void *ptr)
  464. {
  465.     U_CHAR c = (U_CHAR) ESCAPE;
  466.  
  467.     dbug_enter("plD_esc_tk");
  468.  
  469.     tk_wr( pdf_wr_1byte(pls->pdfs, c) );
  470.     tk_wr( pdf_wr_1byte(pls->pdfs, op) );
  471.  
  472.     switch (op) {
  473.  
  474.     case PLESC_DI:
  475.     tk_di(pls);
  476.     break;
  477.  
  478.     case PLESC_FLUSH:
  479.     flush_output(pls);
  480.     break;
  481.  
  482.     case PLESC_FILL:
  483.     tk_fill(pls);
  484.     break;
  485.  
  486.     case PLESC_EH:
  487.     HandleEvents(pls);
  488.     break;
  489.     }
  490. }
  491.  
  492. /*----------------------------------------------------------------------*\
  493.  * tk_di
  494.  *
  495.  * Process driver interface command.
  496.  * Just send the command to the remote plplot library.
  497. \*----------------------------------------------------------------------*/
  498.  
  499. static void
  500. tk_di(PLStream *pls)
  501. {
  502.     TkDev *dev = (TkDev *) pls->dev;
  503.     char str[10];
  504.  
  505.     dbug_enter("tk_di");
  506.  
  507. /* Safety feature, should never happen */
  508.  
  509.     if (dev == NULL) {
  510.     plabort("tk_di: Illegal call to driver (not yet initialized)");
  511.     return;
  512.     }
  513.  
  514. /* Flush the buffer before proceeding */
  515.  
  516.     flush_output(pls);
  517.  
  518. /* Change orientation */
  519.  
  520.     if (pls->difilt & PLDI_ORI) {
  521.     sprintf(str, "%f", pls->diorot);
  522.     Tcl_SetVar(dev->interp, "rot", str, 0);
  523.  
  524.     server_cmd( pls, "$plwidget cmd plsetopt -ori $rot", 1 );
  525.     pls->difilt &= ~PLDI_ORI;
  526.     }
  527.  
  528. /* Change window into plot space */
  529.  
  530.     if (pls->difilt & PLDI_PLT) {
  531.     sprintf(str, "%f", pls->dipxmin);
  532.     Tcl_SetVar(dev->interp, "xl", str, 0);
  533.     sprintf(str, "%f", pls->dipymin);
  534.     Tcl_SetVar(dev->interp, "yl", str, 0);
  535.     sprintf(str, "%f", pls->dipxmax);
  536.     Tcl_SetVar(dev->interp, "xr", str, 0);
  537.     sprintf(str, "%f", pls->dipymax);
  538.     Tcl_SetVar(dev->interp, "yr", str, 0);
  539.  
  540.     server_cmd( pls, "$plwidget cmd plsetopt -wplt $xl,$yl,$xr,$yr", 1 );
  541.     pls->difilt &= ~PLDI_PLT;
  542.     }
  543.  
  544. /* Change window into device space */
  545.  
  546.     if (pls->difilt & PLDI_DEV) {
  547.     sprintf(str, "%f", pls->mar);
  548.     Tcl_SetVar(dev->interp, "mar", str, 0);
  549.     sprintf(str, "%f", pls->aspect);
  550.     Tcl_SetVar(dev->interp, "aspect", str, 0);
  551.     sprintf(str, "%f", pls->jx);
  552.     Tcl_SetVar(dev->interp, "jx", str, 0);
  553.     sprintf(str, "%f", pls->jy);
  554.     Tcl_SetVar(dev->interp, "jy", str, 0);
  555.  
  556.     server_cmd( pls, "$plwidget cmd plsetopt -mar $mar", 1 );
  557.     server_cmd( pls, "$plwidget cmd plsetopt -a $aspect", 1 );
  558.     server_cmd( pls, "$plwidget cmd plsetopt -jx $jx", 1 );
  559.     server_cmd( pls, "$plwidget cmd plsetopt -jy $jy", 1 );
  560.     pls->difilt &= ~PLDI_DEV;
  561.     }
  562.  
  563. /* Update view */
  564.  
  565.     server_cmd( pls, "update", 1 );
  566.     server_cmd( pls, "plw_update_view $plwindow", 1 );
  567. }
  568.  
  569. /*----------------------------------------------------------------------*\
  570.  * tk_fill()
  571.  *
  572.  * Fill polygon described in points pls->dev_x[] and pls->dev_y[].
  573. \*----------------------------------------------------------------------*/
  574.  
  575. static void
  576. tk_fill(PLStream *pls)
  577. {
  578.     PLDev *dev = (PLDev *) pls->dev;
  579.  
  580.     dbug_enter("tk_fill");
  581.  
  582.     tk_wr( pdf_wr_2bytes(pls->pdfs, (U_SHORT) pls->dev_npts) );
  583.  
  584.     tk_wr( pdf_wr_2nbytes(pls->pdfs, (U_SHORT *) pls->dev_x, pls->dev_npts) );
  585.     tk_wr( pdf_wr_2nbytes(pls->pdfs, (U_SHORT *) pls->dev_y, pls->dev_npts) );
  586.  
  587.     dev->xold = UNDEFINED;
  588.     dev->yold = UNDEFINED;
  589. }
  590.  
  591. /*----------------------------------------------------------------------*\
  592.  * tk_start
  593.  *
  594.  * Create TCL interpreter and spawn off server process.
  595.  * Each stream that uses the tk driver gets its own interpreter.
  596. \*----------------------------------------------------------------------*/
  597.  
  598. static void
  599. tk_start(PLStream *pls)
  600. {
  601.     TkDev *dev = (TkDev *) pls->dev;
  602.  
  603.     dbug_enter("tk_start");
  604.  
  605. /* Instantiate a TCL interpreter, and get rid of the exec command */
  606.  
  607.     dev->interp = Tcl_CreateInterp();
  608.     tcl_cmd(pls, "rename exec {}");
  609.  
  610. /* Initialize top level window */
  611. /* Request a variant on pls->program (if set) for the main window name */
  612.  
  613.     if (pls->program == NULL)
  614.     pls->program = "plclient";
  615.  
  616.     if (pls->dp) {
  617.     Tcl_SetVar(dev->interp, "dp", "1", TCL_GLOBAL_ONLY);
  618.     }
  619.     else {
  620.     char name[80];
  621.     sprintf(name, "_%s_%02d", pls->program, pls->ipls); 
  622.     Tcl_SetVar(dev->interp, "dp", "0", TCL_GLOBAL_ONLY);
  623.     if (pltk_toplevel(&dev->w, dev->interp, pls->FileName, name, name))
  624.         abort_session(pls, "Unable to create top-level window");
  625.     }
  626.  
  627. /* Eval startup procs */
  628.  
  629.     if (pltkdriver_Init(pls) != TCL_OK) {
  630.     abort_session(pls, "");
  631.     }
  632.  
  633. /* Other initializations. */
  634. /* Autoloaded, so the user can customize it if desired */
  635.  
  636.     tcl_cmd(pls, "plclient_init"); 
  637.  
  638. /* A different way to customize the interface. */
  639. /* E.g. used by plrender to add a back page button. */
  640.  
  641.     if (pls->tcl_cmd) 
  642.     tcl_cmd(pls, pls->tcl_cmd);
  643.  
  644. /* Initialize server process */
  645.  
  646.     init_server(pls);
  647.  
  648. /* By now we should be done with all autoloaded procs, so blow away */
  649. /* the open command just in case security has been compromised */
  650.  
  651.     tcl_cmd(pls, "rename open {}");
  652.     tcl_cmd(pls, "rename rename {}");
  653.  
  654. /* Initialize widgets */
  655.  
  656.     plwindow_init(pls);
  657.  
  658. /* Initialize data link */
  659.  
  660.     link_init(pls);
  661.  
  662.     return;
  663. }
  664.  
  665. /*----------------------------------------------------------------------*\
  666.  * tk_stop
  667.  *
  668.  * Normal termination & cleanup.
  669. \*----------------------------------------------------------------------*/
  670.  
  671. static void
  672. tk_stop(PLStream *pls)
  673. {
  674.     TkDev *dev = (TkDev *) pls->dev;
  675.  
  676.     dbug_enter("tk_stop");
  677.  
  678. /* Safety check for out of control code */
  679.  
  680.     if (dev->pass_thru)
  681.     return;
  682.  
  683.     dev->pass_thru = 1;
  684.  
  685. /* Terminate data stream */
  686.  
  687.     pdf_close(pls->pdfs);
  688.  
  689. /* Kill plserver */
  690.  
  691.     if (Tcl_GetVar(dev->interp, "server", TCL_GLOBAL_ONLY) != NULL) {
  692.     server_cmd( pls, "$plw_end_proc $plwindow", 1 );
  693.     tcl_cmd(pls, "unset server");
  694.     }
  695.  
  696. /* Blow away main window */
  697.  
  698.     if ( ! pls->dp)
  699.     tcl_cmd(pls, "destroy .");
  700.  
  701. /* Blow away interpreter if it exists */
  702.  
  703.     if (dev->interp != NULL) {
  704.     Tcl_DeleteInterp(dev->interp);
  705.     dev->interp = NULL;
  706.     }
  707. }
  708.  
  709. /*----------------------------------------------------------------------*\
  710.  * abort_session
  711.  *
  712.  * Terminates with an error.  
  713.  * Cleanup is done here, and once pls->level is cleared the driver will
  714.  * never be called again. 
  715. \*----------------------------------------------------------------------*/
  716.  
  717. static void
  718. abort_session(PLStream *pls, char *msg)
  719. {
  720.     TkDev *dev = (TkDev *) pls->dev;
  721.  
  722.     dbug_enter("abort_session");
  723.  
  724. /* Safety check for out of control code */
  725.  
  726.     if (dev->pass_thru)
  727.     return;
  728.  
  729.     tk_stop(pls);
  730.     free_mem(dev->cmdbuf);
  731.     pls->level = 0;
  732.  
  733.     plexit(msg);
  734. }
  735.  
  736. /*----------------------------------------------------------------------*\
  737.  * pltkdriver_Init
  738.  *
  739.  * Performs PLplot/TK driver-specific Tcl initialization.
  740. \*----------------------------------------------------------------------*/
  741.  
  742. static int
  743. pltkdriver_Init(PLStream *pls)
  744. {
  745.     TkDev *dev = (TkDev *) pls->dev;
  746.     Tcl_Interp *interp = (Tcl_Interp *) dev->interp;
  747.  
  748.     Tk_Window main;
  749.  
  750.     main = Tk_MainWindow(interp);
  751.  
  752.     /*
  753.      * Call the init procedures for included packages.  Each call should
  754.      * look like this:
  755.      *
  756.      * if (Mod_Init(interp) == TCL_ERROR) {
  757.      *     return TCL_ERROR;
  758.      * }
  759.      *
  760.      * where "Mod" is the name of the module.
  761.      */
  762.  
  763.     if (Tcl_Init(interp) == TCL_ERROR) {
  764.     return TCL_ERROR;
  765.     }
  766.     if (main && Tk_Init(interp) == TCL_ERROR) {
  767.     return TCL_ERROR;
  768.     }
  769.  
  770. #ifdef PLD_dp
  771.     if (pls->dp) {
  772.     if (Tdp_Init(interp) == TCL_ERROR) {
  773.         return TCL_ERROR;
  774.     }
  775.     }
  776. #endif
  777.  
  778.     /*
  779.      * Call Tcl_CreateCommand for application-specific commands, if
  780.      * they weren't already created by the init procedures called above.
  781.      */
  782.  
  783.     Tcl_CreateCommand(interp, "wait_until", plWait_Until,
  784.               (ClientData) NULL, (void (*) (ClientData)) NULL);
  785.  
  786. #ifdef PLD_dp
  787.     if (pls->dp) {
  788.     Tcl_CreateCommand(interp, "host_id", plHost_ID,
  789.               (ClientData) NULL, (void (*) (ClientData)) NULL);
  790.     }
  791. #endif
  792.  
  793.     Tcl_CreateCommand(interp, "abort", Abort,
  794.               (ClientData) pls, (void (*) (ClientData)) NULL);
  795.  
  796.     Tcl_CreateCommand(interp, "keypress", KeyEH,
  797.               (ClientData) pls, (void (*) (ClientData)) NULL);
  798.  
  799.     Tcl_CreateCommand(interp, "mouse", MouseEH,
  800.               (ClientData) pls, (void (*)()) NULL);
  801.  
  802. /* Set some relevant interpreter variables */
  803.  
  804.     if (! pls->dp) 
  805.     tcl_cmd(pls, "set client_name [winfo name .]");
  806.  
  807.     if (pls->server_name != NULL)
  808.     Tcl_SetVar(interp, "server_name", pls->server_name, 0);
  809.  
  810.     if (pls->server_host != NULL)
  811.     Tcl_SetVar(interp, "server_host", pls->server_host, 0);
  812.  
  813.     if (pls->server_port != NULL)
  814.     Tcl_SetVar(interp, "server_port", pls->server_port, 0);
  815.  
  816. /* Set up auto_path */
  817.  
  818.     if (pls_auto_path(interp) == TCL_ERROR)
  819.     return TCL_ERROR;
  820.  
  821.     return TCL_OK;
  822. }
  823.  
  824. /*----------------------------------------------------------------------*\
  825.  * init_server
  826.  *
  827.  * Starts interaction with server process, launching it if necessary.
  828.  *
  829.  * There are several possibilities we must account for, depending on the
  830.  * message protocol, input flags, and whether plserver is already running
  831.  * or not.  From the point of view of the code, they are:
  832.  *
  833.  *    1. Driver: tk
  834.  *    Flags: <none>
  835.  *    Meaning: need to start up plserver (same host)
  836.  *    Actions: fork plserver, passing it our TK main window name
  837.  *         for communication.  Once started, plserver will send
  838.  *         back its main window name.
  839.  * 
  840.  *    2. Driver: dp
  841.  *    Flags: <none>
  842.  *    Meaning: need to start up plserver (same host)
  843.  *    Actions: fork plserver, passing it our Tcl-DP communication port
  844.  *         for communication. Once started, plserver will send
  845.  *         back its created message port number.
  846.  * 
  847.  *    3. Driver: tk
  848.  *    Flags: -server_name
  849.  *    Meaning: plserver already running (same host)
  850.  *    Actions: communicate to plserver our TK main window name.
  851.  * 
  852.  *    4. Driver: dp
  853.  *    Flags: -server_port
  854.  *    Meaning: plserver already running (same host)
  855.  *    Actions: communicate to plserver our Tcl-DP port number.
  856.  * 
  857.  *    5. Driver: dp
  858.  *    Flags: -server_host
  859.  *    Meaning: need to start up plserver (remote host)
  860.  *    Actions: remsh (rsh) plserver, passing it our host ID and Tcl-DP
  861.  *         port for communication. Once started, plserver will send
  862.  *         back its created message port number.
  863.  * 
  864.  *    6. Driver: dp
  865.  *    Flags: -server_host -server_port
  866.  *    Meaning: plserver already running (remote host)
  867.  *    Actions: communicate to remote plserver our host ID and Tcl-DP
  868.  *         port number.
  869.  *
  870.  * For a bit more flexibility, you can change the name of the process
  871.  * invoked from "plserver" to something else, using the -plserver flag.
  872.  * 
  873.  * The startup procedure involves some rather involved handshaking 
  874.  * between client and server.  This is made easier by using the Tcl
  875.  * variables:
  876.  *
  877.  *    client_host client_port server_host server_port 
  878.  *
  879.  * when using Tcl-DP sends and
  880.  *
  881.  *    client_name server_name
  882.  *
  883.  * when using TK sends.  The global Tcl variables 
  884.  *
  885.  *    client server
  886.  *
  887.  * are used for the defining identification for the client and server,
  888.  * respectively -- they denote the main window name when TK sends are used
  889.  * and the respective process's listening socket when Tcl-DP sends are
  890.  * used.  Note that in the former case, $client is just the same as
  891.  * $client_name.  In addition, since the server may need to communicate
  892.  * with many different processes, every command to the server contains the
  893.  * sender's client id (so it knows how to report back if necessary).  Thus
  894.  * this interpreter must know both $server as well as $client.  It is most
  895.  * convenient to set $client from the server, as a way to signal that
  896.  * communication has been set up and it is safe to proceed.
  897.  *
  898.  * Often it is necessary to use constructs such as [list $server] instead
  899.  * of just $server.  This occurs since you could have multiple copies
  900.  * running on the display (resulting in names of the form "plserver #2",
  901.  * etc).
  902. \*----------------------------------------------------------------------*/
  903.  
  904. static void
  905. init_server(PLStream *pls)
  906. {
  907.     int server_exists = 0;
  908.  
  909.     dbug_enter("init_server");
  910.  
  911. #ifdef DEBUG
  912.     fprintf(stderr, "%s -- PID: %d, PGID: %d, PPID: %d\n",
  913.         __FILE__, (int) getpid(), (int) getpgrp(), (int) getppid());
  914. #endif
  915.  
  916. /* If no means of communication provided, need to launch plserver */
  917.  
  918.     if (( ! pls->dp && pls->server_name != NULL ) ||
  919.     (   pls->dp && pls->server_port != NULL ) )
  920.     server_exists = 1;
  921.  
  922. /* So launch it */
  923.  
  924.     if ( ! server_exists)
  925.     launch_server(pls);
  926.  
  927. /* Set up communication channel to server */
  928.  
  929.     if (pls->dp) {
  930.     tcl_cmd(pls,
  931.         "set server [dp_MakeRPCClient $server_host $server_port]");
  932.     }
  933.     else {
  934.     tcl_cmd(pls, "set server $server_name");
  935.     }
  936.  
  937. /* If server didn't need launching, contact it here */
  938.  
  939.     if (server_exists)
  940.     tcl_cmd(pls, "plclient_link_init"); 
  941. }
  942.  
  943. /*----------------------------------------------------------------------*\
  944.  * launch_server
  945.  *
  946.  * Launches plserver, locally or remotely.
  947. \*----------------------------------------------------------------------*/
  948.  
  949. static void
  950. launch_server(PLStream *pls)
  951. {
  952.     TkDev *dev = (TkDev *) pls->dev;
  953.     char *argv[20], *plserver_exec, *ptr;
  954.     int i;
  955.     pid_t pid;
  956.  
  957.     dbug_enter("launch_server");
  958.  
  959.     if (pls->plserver == NULL) 
  960.     pls->plserver = "plserver";
  961.  
  962. /* Build argument list */
  963.  
  964.     i = 0;
  965.  
  966. /* If we're doing a remsh, need to set up its arguments first. */
  967.  
  968.     if ( pls->dp && pls->server_host != NULL ) {
  969.     argv[i++] = pls->server_host;    /* Host name for remsh */
  970.  
  971.     if (pls->user != NULL) {
  972.         argv[i++] = "-l";
  973.         argv[i++] = pls->user;     /* User name on remote node */
  974.     }
  975.     }
  976.  
  977. /* The invoked executable name comes next */
  978.  
  979.     argv[i++] = pls->plserver;
  980.  
  981. /* The rest are arguments to plserver */
  982.  
  983.     argv[i++] = "-child";        /* Tell plserver its ancestry */
  984.  
  985.     argv[i++] = "-e";            /* Startup script */
  986.     argv[i++] = "plserver_init";
  987.  
  988.     if (pls->auto_path != NULL) {
  989.     argv[i++] = "-auto_path";    /* Additional directory(s) */
  990.     argv[i++] = pls->auto_path;    /* to autoload */
  991.     }
  992.  
  993.     if (pls->geometry != NULL) {
  994.     argv[i++] = "-geometry";    /* Top level window geometry */
  995.     argv[i++] = pls->geometry;
  996.     }
  997.  
  998. /* If communicating via Tcl-DP, specify communications port id */
  999. /* If communicating via TK send, specify main window name */
  1000.  
  1001.     if (pls->dp) {
  1002.     argv[i++] = "-client_host";
  1003.     argv[i++] = Tcl_GetVar(dev->interp, "client_host", TCL_GLOBAL_ONLY);
  1004.  
  1005.     argv[i++] = "-client_port";
  1006.     argv[i++] = Tcl_GetVar(dev->interp, "client_port", TCL_GLOBAL_ONLY);
  1007.  
  1008.     if (pls->user != NULL) {
  1009.         argv[i++] = "-l";
  1010.         argv[i++] = pls->user;
  1011.     }
  1012.     }
  1013.     else {
  1014.     argv[i++] = "-client_name";
  1015.     argv[i++] = Tcl_GetVar(dev->interp, "client_name", TCL_GLOBAL_ONLY);
  1016.     }
  1017.  
  1018. /* The display absolutely must be set if invoking a remote server (by remsh) */
  1019. /* Use the DISPLAY environmental, if set.  Otherwise use the remote host. */
  1020.  
  1021.     if (pls->FileName != NULL) {
  1022.     argv[i++] = "-display";
  1023.     argv[i++] = pls->FileName;
  1024.     }
  1025.     else if ( pls->dp && pls->server_host != NULL ) {
  1026.     argv[i++] = "-display";
  1027.     if ((ptr = getenv("DISPLAY")) != NULL)
  1028.         argv[i++] = ptr;
  1029.     else
  1030.         argv[i++] = "unix:0.0";
  1031.     }
  1032.  
  1033. /* Add terminating null */
  1034.  
  1035. #ifdef DEBUG
  1036.     {
  1037.     int j;
  1038.     fprintf(stderr, "argument list: \n   ");
  1039.     for (j = 0; j < i; j++) 
  1040.         fprintf(stderr, "%s ", argv[j]);
  1041.     fprintf(stderr, "\n");
  1042.     }
  1043. #endif
  1044.     argv[i++] = NULL;
  1045.  
  1046. /* Start server process */
  1047. /* It's a fork/remsh if on a remote machine */
  1048.  
  1049.     if ( pls->dp && pls->server_host != NULL ) {
  1050.     if ((pid = vfork()) < 0) {
  1051.         abort_session(pls, "Unable to fork server process");
  1052.     }
  1053.     else if (pid == 0) {
  1054.         fprintf(stderr, "Starting up %s on node %s\n", pls->plserver,
  1055.             pls->server_host);
  1056.  
  1057.         if (execvp("remsh", argv)) {
  1058.         perror("Unable to exec server process");
  1059.         _exit(1);
  1060.         }
  1061.     }
  1062.     }
  1063.  
  1064. /* Running locally, so its a fork/exec */
  1065.  
  1066.     else {
  1067.     plserver_exec = plFindCommand(pls->plserver);
  1068.     if ( (plserver_exec == NULL) || (pid = vfork()) < 0) {
  1069.         abort_session(pls, "Unable to fork server process");
  1070.     }
  1071.     else if (pid == 0) {
  1072.  
  1073. /* Don't kill plserver on a ^C if pls->server_nokill is set */
  1074. /* Contributed by Ian Searle */
  1075.  
  1076.         if (pls->server_nokill) {
  1077.         int retv;
  1078.         sigset_t *set;
  1079.         set = (sigset_t *) malloc (sizeof(sigset_t));
  1080.         sigfillset (set);
  1081.         sigaddset (set, SIGINT);
  1082.         if ((retv = sigprocmask (SIG_BLOCK, set, 0)) < 0)
  1083.             fprintf(stderr, "plplot: sigprocmask failure\n");
  1084.         }
  1085.         fprintf(stderr, "Starting up %s\n", plserver_exec);
  1086.         if (execv(plserver_exec, argv)) {
  1087.         fprintf(stderr, "Unable to exec server process.\n");
  1088.         _exit(1);
  1089.         }
  1090.     }
  1091.     free_mem(plserver_exec);
  1092.     }
  1093.  
  1094. /* Wait for server to set up return communication channel */
  1095.  
  1096.     tk_wait(pls, "[info exists client]" );
  1097. }
  1098.  
  1099. /*----------------------------------------------------------------------*\
  1100.  * plwindow_init
  1101.  *
  1102.  * Configures the widget hierarchy we are sending the data stream to.  
  1103.  *
  1104.  * If a widget name (identifying the actual widget or a container widget)
  1105.  * hasn't been supplied already we assume it needs to be created.
  1106.  *
  1107.  * In order to achieve maximum flexibility, the plplot tk driver requires
  1108.  * only that certain TCL procs must be defined in the server interpreter.
  1109.  * These can be used to set up the desired widget configuration.  The procs
  1110.  * invoked from this driver currently include:
  1111.  *
  1112.  *    $plw_create_proc        Creates the widget environment
  1113.  *    $plw_start_proc        Does any remaining startup necessary
  1114.  *    $plw_end_proc        Prepares for shutdown
  1115.  *    $plw_flash_proc        Invoked when waiting for page advance
  1116.  *
  1117.  * Since all of these are interpreter variables, they can be trivially
  1118.  * changed by the user.
  1119.  *
  1120.  * Each of these utility procs is called with a widget name ($plwindow)
  1121.  * as argument.  "plwindow" is set from the value of pls->plwindow, and
  1122.  * if null is generated from the name of the client main window (to
  1123.  * ensure uniqueness).  $plwindow usually indicates the container frame
  1124.  * for the actual plplot widget, but can be arbitrary -- as long as the
  1125.  * usage in all the TCL procs is consistent.
  1126.  *
  1127.  * In order that the TK driver be able to invoke the actual plplot
  1128.  * widget, the proc "$plw_create_proc" deposits the widget name in the local
  1129.  * interpreter variable "plwidget".
  1130. \*----------------------------------------------------------------------*/
  1131.  
  1132. static void
  1133. plwindow_init(PLStream *pls)
  1134. {
  1135.     TkDev *dev = (TkDev *) pls->dev;
  1136.     char str[10], *pname;
  1137.     int i;
  1138.  
  1139.     dbug_enter("plwindow_init");
  1140.  
  1141.     if (pls->plwindow == NULL) {
  1142.  
  1143. /* Give window a name */
  1144. /* Eliminate any leading path specification */
  1145.  
  1146.     pls->plwindow = (char *)
  1147.         malloc(10+(strlen(pls->program)) * sizeof(char));
  1148.  
  1149.     pname = strrchr(pls->program, '/');
  1150.     if (pname != NULL) 
  1151.         pname++;
  1152.     else
  1153.         pname = pls->program;
  1154.  
  1155. /* Ensure that multiple widgets created by multiple streams have unique */
  1156. /* names (in case this kind of capability is someday supported) */
  1157.  
  1158.     if (pls->ipls == 0)
  1159.         sprintf(pls->plwindow, ".%s", pname);
  1160.     else
  1161.         sprintf(pls->plwindow, ".%s_%d", pname, (int) pls->ipls);
  1162.  
  1163. /* Replace any blanks with underscores to avoid quoting problems. */
  1164.  
  1165.     for (i = 0; i < strlen(pls->plwindow); i++) {
  1166.         if (pls->plwindow[i] == ' ')
  1167.         pls->plwindow[i] = '_';
  1168.     }
  1169.     }
  1170.  
  1171.     Tcl_SetVar(dev->interp, "plwindow", pls->plwindow, 0);
  1172.  
  1173. /* Create the plframe widget & anything else you want with it. */
  1174.  
  1175.     server_cmd( pls,
  1176.     "$plw_create_proc $plwindow [list $client]", 1 );
  1177.  
  1178.     tk_wait(pls, "[info exists plwidget]" );
  1179.  
  1180. /* Now we should have the actual plplot widget name in $plwidget */
  1181. /* Configure remote plplot stream. */
  1182.  
  1183. /* Configure background color if set */
  1184. /* The default color is handled from a resource setting in plconfig.tcl */
  1185.  
  1186.     if (pls->cmap0setcol[0]) {
  1187.     long bg;
  1188.  
  1189.     bg = pls->cmap0[0].b | (pls->cmap0[0].g << 8) |
  1190.         (pls->cmap0[0].r << 16);
  1191.  
  1192.     sprintf(str, "#%06x", (unsigned int) (bg & 0xFFFFFF));
  1193.     Tcl_SetVar(dev->interp, "bg", str, 0);
  1194.     server_cmd( pls, "$plwidget configure -bg $bg", 0 );
  1195.     }
  1196.  
  1197. /* nopixmap option */
  1198.  
  1199.     if (pls->nopixmap) 
  1200.     server_cmd( pls, "$plwidget cmd plsetopt -nopixmap", 0 );
  1201.  
  1202. /* Start up remote plplot */
  1203.  
  1204.     server_cmd( pls, "$plw_start_proc $plwindow [list $client]", 1 );
  1205.     tk_wait(pls, "[info exists widget_is_ready]" );
  1206. }
  1207.  
  1208. /*----------------------------------------------------------------------*\
  1209.  * link_init
  1210.  *
  1211.  * Initializes the link between the client and the plplot widget for
  1212.  * data transfer.  Defaults to a FIFO when the TK driver is selected and
  1213.  * a socket when the DP driver is selected.
  1214. \*----------------------------------------------------------------------*/
  1215.  
  1216. static void
  1217. link_init(PLStream *pls)
  1218. {
  1219.     TkDev *dev = (TkDev *) pls->dev;
  1220.     PLiodev *iodev = (PLiodev *) dev->iodev;
  1221.     long bufmax = pls->bufmax * 1.2;
  1222.  
  1223.     dbug_enter("link_init");
  1224.  
  1225. /* Create FIFO for data transfer to the plframe widget */
  1226.  
  1227.     if ( ! pls->dp) {
  1228.  
  1229.     iodev->filename = (char *) tmpnam(NULL);
  1230.     if (mkfifo(iodev->filename, S_IRUSR|S_IWUSR|S_IRGRP|S_IROTH) < 0) 
  1231.         abort_session(pls, "mkfifo error");
  1232.  
  1233. /* Tell plframe widget to open FIFO (for reading). */
  1234.  
  1235.     Tcl_SetVar(dev->interp, "fifoname", iodev->filename, 0);
  1236.     server_cmd( pls, "$plwidget openlink fifo $fifoname", 1 );
  1237.  
  1238. /* Open the FIFO for writing */
  1239. /* This will block until the server opens it for reading */
  1240.  
  1241.     if ((iodev->fd = open(iodev->filename, O_WRONLY)) == -1) 
  1242.         abort_session(pls, "Error opening fifo for write");
  1243.  
  1244. /* Create stream interface (C file handle) to FIFO */
  1245.  
  1246.     iodev->type = 0;
  1247.     iodev->typename = "fifo";
  1248.     iodev->file = fdopen(iodev->fd, "wb");
  1249.  
  1250. /* Unlink FIFO so that it isn't left around if program crashes. */
  1251. /* This also ensures no other program can mess with it. */
  1252.  
  1253.     if (unlink(iodev->filename) == -1) 
  1254.         abort_session(pls, "Error removing fifo");
  1255.     }
  1256.  
  1257. /* Create socket for data transfer to the plframe widget */
  1258.  
  1259.     else {
  1260.  
  1261.     iodev->type = 1;
  1262.     iodev->typename = "socket";
  1263.     tcl_cmd(pls, "plclient_dp_init");
  1264.     iodev->filehandle = Tcl_GetVar(dev->interp, "data_sock", 0);
  1265.  
  1266.     if (Tcl_GetOpenFile(dev->interp, iodev->filehandle,
  1267.                 0, 1, &iodev->file) != TCL_OK) {
  1268.  
  1269.         fprintf(stderr, "Cannot get file info:\n\t %s\n",
  1270.             dev->interp->result);
  1271.         abort_session(pls, "");
  1272.     }
  1273.     iodev->fd = fileno(iodev->file);
  1274.     }
  1275.  
  1276. /* Create data buffer */
  1277.  
  1278.     pls->pdfs = pdf_bopen( NULL, bufmax );
  1279. }
  1280.  
  1281. /*----------------------------------------------------------------------*\
  1282.  * WaitForPage()
  1283.  *
  1284.  * Waits for a page advance.
  1285. \*----------------------------------------------------------------------*/
  1286.  
  1287. static void
  1288. WaitForPage(PLStream *pls)
  1289. {
  1290.     TkDev *dev = (TkDev *) pls->dev;
  1291.  
  1292.     dbug_enter("WaitForPage");
  1293.  
  1294.     while ( ! dev->exit_eventloop)
  1295.     Tk_DoOneEvent(0);
  1296.  
  1297.     dev->exit_eventloop = 0;
  1298. }
  1299.  
  1300. /*----------------------------------------------------------------------*\
  1301.  * HandleEvents()
  1302.  *
  1303.  * Just a front-end to the update command.  
  1304. \*----------------------------------------------------------------------*/
  1305.  
  1306. static void
  1307. HandleEvents(PLStream *pls)
  1308. {
  1309.     dbug_enter("HandleEvents");
  1310.  
  1311.     tcl_cmd(pls, "$update_proc");
  1312. }
  1313.  
  1314. /*----------------------------------------------------------------------*\
  1315.  * flush_output()
  1316.  *
  1317.  * Sends graphics instructions to the {FIFO|socket} via a packet send.
  1318.  *
  1319.  * The packet i/o routines are modified versions of the ones from the
  1320.  * Tcl-DP package.  They have been altered to take a pointer to a PDFstrm
  1321.  * struct, and read-to or write-from pdfs->buffer.  The length of the
  1322.  * buffer is stored in pdfs->bp (the original Tcl-DP routine assumes the
  1323.  * message is character data and uses strlen).  Also, they can
  1324.  * send/receive from either a fifo or a socket.
  1325. \*----------------------------------------------------------------------*/
  1326.  
  1327. static void
  1328. flush_output(PLStream *pls)
  1329. {
  1330.     TkDev *dev = (TkDev *) pls->dev;
  1331.     PDFstrm *pdfs = (PDFstrm *) pls->pdfs;
  1332.  
  1333.     dbug_enter("flush_output");
  1334.  
  1335. #ifdef DEBUG
  1336.     fprintf(stderr, "%s: Flushing buffer, bytes = %ld\n",
  1337.         __FILE__, pdfs->bp);
  1338. #endif
  1339.  
  1340.     tcl_cmd(pls, "$update_proc");
  1341.  
  1342. /* Send packet -- filehandler will be invoked automatically. */
  1343.  
  1344.     if (pl_PacketSend(dev->interp, dev->iodev, pls->pdfs)) {
  1345.     fprintf(stderr, "Packet send failed:\n\t %s\n",
  1346.         dev->interp->result);
  1347.     abort_session(pls, "");
  1348.     }
  1349.     pdfs->bp = 0;
  1350. }
  1351.  
  1352. /*----------------------------------------------------------------------*\
  1353.  * Abort
  1354.  *
  1355.  * Just a TCL front-end to abort_session().
  1356. \*----------------------------------------------------------------------*/
  1357.  
  1358. static int
  1359. Abort(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  1360. {
  1361.     PLStream *pls = (PLStream *) clientData;
  1362.  
  1363.     dbug_enter("Abort");
  1364.  
  1365.     abort_session(pls, "");
  1366.     return TCL_OK;
  1367. }
  1368.  
  1369. /*----------------------------------------------------------------------*\
  1370.  * KeyEH()
  1371.  *
  1372.  * This TCL command handles keyboard events.
  1373.  *
  1374.  * Arguments:
  1375.  *    command name
  1376.  *    keysym name (textual string)
  1377.  *    keysym value
  1378.  *    ASCII equivalent (optional)
  1379.  *
  1380.  * The first argument is keysym name -- this is all that's really required 
  1381.  * although it's better to send the numeric keysym value since then we
  1382.  * can avoid a long lookup procedure.  Sometimes, when faking input, it
  1383.  * is inconvenient to have to worry about what the numeric keysym value
  1384.  * is, so in a few cases a missing keysym value is tolerated.
  1385. \*----------------------------------------------------------------------*/
  1386.  
  1387. static int
  1388. KeyEH(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  1389. {
  1390.     PLStream *pls = (PLStream *) clientData;
  1391.     TkDev *dev = (TkDev *) pls->dev;
  1392.  
  1393.     PLKey key;
  1394.     char *keysym, c;
  1395.     int advance = 0;
  1396.  
  1397.     dbug_enter("KeyEH");
  1398.  
  1399.     if (argc < 2) {
  1400.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  1401.         argv[0], " keysym-name ?keysym-value?\"", (char *) NULL);
  1402.     return TCL_ERROR;
  1403.     }
  1404.     key.code = 0;
  1405.     key.string[0] = '\0';
  1406.  
  1407. /* Keysym name */
  1408.  
  1409.     keysym = argv[1];
  1410.  
  1411. /* Keysym value */
  1412. /* If missing, explicitly check for a few common ones */
  1413.  
  1414.     if (argc > 2)
  1415.     key.code = atol(argv[2]);
  1416.  
  1417.     if (argc == 2 || key.code == 0) {
  1418.     c = *keysym;
  1419.     if ((c == 'B') && (strcmp(keysym, "BackSpace") == 0)) {
  1420.         key.code = PLK_BackSpace;
  1421.     }
  1422.     else if ((c == 'D') && (strcmp(keysym, "Delete") == 0)) {
  1423.         key.code = PLK_Delete;
  1424.     }
  1425.     else if ((c == 'L') && (strcmp(keysym, "Linefeed") == 0)) {
  1426.         key.code = PLK_Linefeed;
  1427.     }
  1428.     else if ((c == 'R') && (strcmp(keysym, "Return") == 0)) {
  1429.         key.code = PLK_Return;
  1430.     }
  1431.     else if ((c == 'P') && (strcmp(keysym, "Prior") == 0)) {
  1432.         key.code = PLK_Prior;
  1433.     }
  1434.     else if ((c == 'N') && (strcmp(keysym, "Next") == 0)) {
  1435.         key.code = PLK_Next;
  1436.     }
  1437.     else {
  1438.         Tcl_AppendResult(interp, "Unrecognized keysym \"",
  1439.             argv[1], "\"; must specify keycode", (char *) NULL);
  1440.         return TCL_ERROR;
  1441.     }
  1442.     }
  1443.  
  1444. /* ASCII value */
  1445.  
  1446.     if (argc > 3) {
  1447.     key.string[0] = argv[3][0];
  1448.     key.string[1] = '\0';
  1449.     }
  1450.  
  1451. #ifdef DEBUG
  1452.     fprintf(stderr, "KeyEH: stream: %d, Keysym %s, hex %x, ASCII: %s\n",
  1453.         (int) pls->ipls, keysym, (unsigned int) key.code, key.string);
  1454. #endif
  1455.  
  1456. /* Call user event handler */
  1457. /* Since this is called first, the user can disable all plplot internal
  1458.    event handling by setting key.code to 0 and key.string to '\0' */
  1459.  
  1460.     if (pls->KeyEH != NULL)
  1461.     (*pls->KeyEH) (&key, pls->KeyEH_data, &advance);
  1462.  
  1463. /* Handle internal events */
  1464. /* Advance to next page (i.e. terminate event loop) on a <eol> */
  1465. /* Check for both <CR> and <LF> for portability, also a <Page Down> */
  1466.  
  1467.     if (key.code == PLK_Return ||
  1468.     key.code == PLK_Linefeed ||
  1469.     key.code == PLK_Next)
  1470.     advance = TRUE;
  1471.  
  1472.     if (advance) 
  1473.     dev->exit_eventloop = 1;
  1474.  
  1475. /* Terminate on a 'Q' (not 'q', since it's too easy to hit by mistake) */
  1476.  
  1477.     if (key.string[0] == 'Q') 
  1478.     tcl_cmd(pls, "abort");
  1479.  
  1480.     return TCL_OK;
  1481. }
  1482.  
  1483. /*----------------------------------------------------------------------*\
  1484.  * MouseEH()
  1485.  *
  1486.  * This TCL command handles mouse buttonpress events.
  1487.  * Written by Radey Shouman
  1488.  *
  1489.  * Arguments:
  1490.  *    command name
  1491.  *       button number
  1492.  *    state (decimal string)
  1493.  *    x coordinate normalized to [0.0 1.0]
  1494.  *    y coordinate normalized to [0.0 1.0]
  1495.  *
  1496. \*----------------------------------------------------------------------*/
  1497.  
  1498. static int
  1499. MouseEH(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  1500. {
  1501.     PLStream *pls = (PLStream *) clientData;
  1502.     TkDev *dev = (TkDev *) pls->dev;
  1503.  
  1504.     PLMouse mouse;
  1505.     int advance = 0;
  1506.  
  1507.     dbug_enter("MouseEH");
  1508.  
  1509.     if (argc != 5) {
  1510.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1511.         argv[0], " button-number state x y\"", (char *) NULL);
  1512.     return TCL_ERROR;
  1513.     }
  1514.  
  1515.     mouse.button = atol(argv[1]);
  1516.     mouse.state = atol(argv[2]);
  1517.     mouse.x = atof(argv[3]);
  1518.     mouse.y = atof(argv[4]);
  1519.  
  1520. #ifdef DEBUG
  1521.     printf("MouseEH: button %d, state %d, x: %f, y: %f\n",
  1522.        mouse.button, mouse.state, mouse.x, mouse.y);
  1523. #endif
  1524.  
  1525. /* Call user event handler */
  1526.  
  1527.     if (pls->MouseEH != NULL) {
  1528.         (*pls->MouseEH) (&mouse, pls->MouseEH_data, &advance);
  1529.     if (advance)
  1530.       Tcl_SetVar(dev->interp, "advance", "1", 0);
  1531.     }
  1532.     return TCL_OK;
  1533. }
  1534.  
  1535. /*----------------------------------------------------------------------*\
  1536.  *
  1537.  * pltk_toplevel --
  1538.  *
  1539.  *    Create top level window without mapping it.
  1540.  *
  1541.  * Results:
  1542.  *    Returns 1 on error.
  1543.  *
  1544.  * Side effects:
  1545.  *    Returns window ID as *w.
  1546.  *
  1547. \*----------------------------------------------------------------------*/
  1548.  
  1549. static int
  1550. pltk_toplevel(Tk_Window *w, Tcl_Interp *interp,
  1551.           char *display, char *basename, char *classname)
  1552. {
  1553.     char *new_name;
  1554.     static char wcmd[] = "wm withdraw .";
  1555.  
  1556. /*
  1557.  * Determine server name.  If it contains any forward slashes ("/"), only
  1558.  * use the part following the last "/" so that name can be loaded with 
  1559.  * argv[0] by caller.
  1560.  */
  1561.     new_name = strrchr(basename, '/');
  1562.     if (new_name != NULL) 
  1563.     basename = ++new_name;
  1564.  
  1565.     new_name = strrchr(classname, '/');
  1566.     if (new_name != NULL) 
  1567.     classname = ++new_name;
  1568.  
  1569. /* Create the main window without mapping it */
  1570.  
  1571.     *w = Tk_CreateMainWindow(interp, display, basename, classname);
  1572.  
  1573.     if (*w == NULL) {
  1574.     fprintf(stderr, "%s\n", (interp)->result);
  1575.     return(1);
  1576.     }
  1577.  
  1578.     Tcl_VarEval(interp, wcmd, (char *) NULL);
  1579.  
  1580.     return(0);
  1581. }
  1582.  
  1583. /*----------------------------------------------------------------------*\
  1584.  * tk_wait()
  1585.  *
  1586.  * Waits for the specified expression to evaluate to true before
  1587.  * proceeding.  While we are waiting to proceed, all events (for this
  1588.  * or other interpreters) are handled.  
  1589.  *
  1590.  * Use a static string buffer to hold the command, to ensure it's in
  1591.  * writable memory (grrr...).
  1592. \*----------------------------------------------------------------------*/
  1593.  
  1594. static void
  1595. tk_wait(PLStream *pls, char *cmd)
  1596. {
  1597.     TkDev *dev = (TkDev *) pls->dev;
  1598.     int result = 0;
  1599.  
  1600.     dbug_enter("tk_wait");
  1601.  
  1602.     copybuf(pls, cmd);
  1603.     for (;;) {
  1604.     if (Tcl_ExprBoolean(dev->interp, dev->cmdbuf, &result)) {
  1605.         fprintf(stderr, "tk_wait command \"%s\" failed:\n\t %s\n",
  1606.             cmd, dev->interp->result);
  1607.         break;
  1608.     }
  1609.     if (result)
  1610.         break;
  1611.  
  1612.     Tk_DoOneEvent(0);
  1613.     }
  1614. }
  1615.  
  1616. /*----------------------------------------------------------------------*\
  1617.  * server_cmd
  1618.  *
  1619.  * Sends specified command to server, aborting on an error.
  1620.  * If nowait is set, the command is issued in the background.
  1621.  *
  1622.  * If commands MUST proceed in a certain order (e.g. initialization), it
  1623.  * is safest to NOT run them in the background.
  1624.  *
  1625.  * In order to protect args that have embedded spaces in them, I enclose
  1626.  * the entire command in a [list ...], but for TK sends ONLY.  If done with
  1627.  * Tcl-DP RPC, the sent command is no longer recognized.  Evidently an
  1628.  * extra scan of the line is done with TK sends for some reason.
  1629. \*----------------------------------------------------------------------*/
  1630.  
  1631. static void
  1632. server_cmd(PLStream *pls, char *cmd, int nowait)
  1633. {
  1634.     TkDev *dev = (TkDev *) pls->dev;
  1635.     static char dpsend_cmd0[] = "dp_RPC $server ";
  1636.     static char dpsend_cmd1[] = "dp_RDO $server ";
  1637.     static char tksend_cmd0[] = "send $server ";
  1638.     static char tksend_cmd1[] = "send $server after 1 ";
  1639.     int result;
  1640.  
  1641.     dbug_enter("server_cmd");
  1642. #ifdef DEBUG
  1643.     fprintf(stderr, "Sending command: %s\n", cmd);
  1644. #endif
  1645.  
  1646.     if (pls->dp) {
  1647.     if (nowait) 
  1648.         result = Tcl_VarEval(dev->interp, dpsend_cmd1, cmd,
  1649.                  (char **) NULL);
  1650.     else
  1651.         result = Tcl_VarEval(dev->interp, dpsend_cmd0, cmd,
  1652.                  (char **) NULL);
  1653.     } 
  1654.     else {
  1655.     if (nowait) 
  1656.         result = Tcl_VarEval(dev->interp, tksend_cmd1, "[list ",
  1657.                  cmd, "]", (char **) NULL);
  1658.     else
  1659.         result = Tcl_VarEval(dev->interp, tksend_cmd0, "[list ",
  1660.                  cmd, "]", (char **) NULL);
  1661.     }
  1662.  
  1663.     if (result != TCL_OK) {
  1664.     fprintf(stderr, "Server command \"%s\" failed:\n\t %s\n",
  1665.         cmd, dev->interp->result);
  1666.     abort_session(pls, "");
  1667.     }
  1668. }
  1669.  
  1670. /*----------------------------------------------------------------------*\
  1671.  * tcl_cmd
  1672.  *
  1673.  * Evals the specified command, aborting on an error.
  1674. \*----------------------------------------------------------------------*/
  1675.  
  1676. static void
  1677. tcl_cmd(PLStream *pls, char *cmd)
  1678. {
  1679.     TkDev *dev = (TkDev *) pls->dev;
  1680.  
  1681.     dbug_enter("tcl_cmd");
  1682. #ifdef DEBUG_ENTER
  1683.     fprintf(stderr, "Evaluating command: %s\n", cmd);
  1684. #endif
  1685.  
  1686.     if (Tcl_VarEval(dev->interp, cmd, (char **) NULL) != TCL_OK) {
  1687.     fprintf(stderr, "TCL command \"%s\" failed:\n\t %s\n",
  1688.         cmd, dev->interp->result);
  1689.     abort_session(pls, "");
  1690.     }
  1691. }
  1692.  
  1693. /*----------------------------------------------------------------------*\
  1694.  * copybuf
  1695.  *
  1696.  * Puts command in a static string buffer, to ensure it's in writable
  1697.  * memory (grrr...).
  1698. \*----------------------------------------------------------------------*/
  1699.  
  1700. static void
  1701. copybuf(PLStream *pls, char *cmd)
  1702. {
  1703.     TkDev *dev = (TkDev *) pls->dev;
  1704.  
  1705.     if (dev->cmdbuf == NULL) {
  1706.     dev->cmdbuf_len = 100;
  1707.     dev->cmdbuf = (char *) malloc(dev->cmdbuf_len);
  1708.     }
  1709.  
  1710.     if (strlen(cmd) >= dev->cmdbuf_len) {
  1711.     free((void *) dev->cmdbuf);
  1712.     dev->cmdbuf_len = strlen(cmd) + 20;
  1713.     dev->cmdbuf = (char *) malloc(dev->cmdbuf_len);
  1714.     }
  1715.  
  1716.     strcpy(dev->cmdbuf, cmd);
  1717. }
  1718.  
  1719. /*----------------------------------------------------------------------*/
  1720. #else
  1721. int
  1722. pldummy_tk()
  1723. {
  1724.     return 0;
  1725. }
  1726.  
  1727. #endif                /* PLD_tk */
  1728.