PLplot  5.10.0
tk.c
Go to the documentation of this file.
00001 //      PLplot Tcl/Tk and Tcl-DP device drivers.
00002 //      Should be broken up somewhat better to allow use of DP w/o X.
00003 //
00004 //      Maurice LeBrun
00005 //      30-Apr-93
00006 //
00007 // Copyright (C) 2004  Maurice LeBrun
00008 // Copyright (C) 2004  Joao Cardoso
00009 // Copyright (C) 2004  Andrew Ross
00010 //
00011 // This file is part of PLplot.
00012 //
00013 // PLplot is free software; you can redistribute it and/or modify
00014 // it under the terms of the GNU Library General Public License as published
00015 // by the Free Software Foundation; either version 2 of the License, or
00016 // (at your option) any later version.
00017 //
00018 // PLplot is distributed in the hope that it will be useful,
00019 // but WITHOUT ANY WARRANTY; without even the implied warranty of
00020 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00021 // GNU Library General Public License for more details.
00022 //
00023 // You should have received a copy of the GNU Library General Public License
00024 // along with PLplot; if not, write to the Free Software
00025 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
00026 //
00027 
00028 //
00029 // #define DEBUG_ENTER
00030 //
00031 
00032 #define DEBUG
00033 
00034 #include "plDevs.h"
00035 
00036 #ifdef PLD_tk
00037 
00038 #define NEED_PLDEBUG
00039 #include "pltkd.h"
00040 #include "pltcl.h"
00041 #include "tcpip.h"
00042 #include "drivers.h"
00043 #include "metadefs.h"
00044 #include "plevent.h"
00045 #include <X11/keysym.h>
00046 
00047 #if PL_HAVE_UNISTD_H
00048 # include <unistd.h>
00049 #endif
00050 #include <sys/types.h>
00051 #if HAVE_SYS_WAIT_H
00052 # include <sys/wait.h>
00053 #endif
00054 #include <sys/stat.h>
00055 #include <fcntl.h>
00056 #include <errno.h>
00057 #include <signal.h>
00058 
00059 #ifdef PLD_dp
00060 # include <dp.h>
00061 #endif
00062 
00063 // Device info
00064 PLDLLIMPEXP_DRIVER const char* plD_DEVICE_INFO_tk = "tk:Tcl/TK Window:1:tk:7:tk\n";
00065 
00066 
00067 // Number of instructions to skip between updates
00068 
00069 #define MAX_INSTR    100
00070 
00071 // Pixels/mm
00072 
00073 #define PHYSICAL    0                   // Enables physical scaling..
00074 
00075 // These need to be distinguished since the handling is slightly different.
00076 
00077 #define LOCATE_INVOKED_VIA_API       1
00078 #define LOCATE_INVOKED_VIA_DRIVER    2
00079 
00080 #define STR_LEN                      10
00081 #define CMD_LEN                      100
00082 
00083 // A handy command wrapper
00084 
00085 #define tk_wr( code ) \
00086     if ( code ) { abort_session( pls, "Unable to write to PDFstrm" ); }
00087 
00088 //--------------------------------------------------------------------------
00089 // Function prototypes
00090 
00091 // Driver entry and dispatch setup
00092 
00093 void plD_dispatch_init_tk( PLDispatchTable *pdt );
00094 
00095 void plD_init_tk( PLStream * );
00096 void plD_line_tk( PLStream *, short, short, short, short );
00097 void plD_polyline_tk( PLStream *, short *, short *, PLINT );
00098 void plD_eop_tk( PLStream * );
00099 void plD_bop_tk( PLStream * );
00100 void plD_tidy_tk( PLStream * );
00101 void plD_state_tk( PLStream *, PLINT );
00102 void plD_esc_tk( PLStream *, PLINT, void * );
00103 void plD_init_dp( PLStream *pls );
00104 
00105 // various
00106 
00107 static void  init( PLStream *pls );
00108 static void  tk_start( PLStream *pls );
00109 static void  tk_stop( PLStream *pls );
00110 static void  tk_di( PLStream *pls );
00111 static void  tk_fill( PLStream *pls );
00112 static void  WaitForPage( PLStream *pls );
00113 static void  CheckForEvents( PLStream *pls );
00114 static void  HandleEvents( PLStream *pls );
00115 static void  init_server( PLStream *pls );
00116 static void  launch_server( PLStream *pls );
00117 static void  flush_output( PLStream *pls );
00118 static void  plwindow_init( PLStream *pls );
00119 static void  link_init( PLStream *pls );
00120 static void  GetCursor( PLStream *pls, PLGraphicsIn *ptr );
00121 static void  tk_XorMod( PLStream *pls, PLINT *ptr );
00122 static void  set_windowname( PLStream *pls );
00123 
00124 // performs Tk-driver-specific initialization
00125 
00126 static int   pltkdriver_Init( PLStream *pls );
00127 
00128 // Tcl/TK utility commands
00129 
00130 static void  tk_wait( PLStream *pls, const char * );
00131 static void  abort_session( PLStream *pls, const char * );
00132 static void  server_cmd( PLStream *pls, const char *, int );
00133 static void  tcl_cmd( PLStream *pls, const char * );
00134 static void  copybuf( PLStream *pls, const char *cmd );
00135 static int   pltk_toplevel( Tk_Window *w, Tcl_Interp *interp );
00136 
00137 static void  ProcessKey( PLStream *pls );
00138 static void  ProcessButton( PLStream *pls );
00139 static void  LocateKey( PLStream *pls );
00140 static void  LocateButton( PLStream *pls );
00141 static void  Locate( PLStream *pls );
00142 
00143 // These are internal TCL commands
00144 
00145 static int   Abort( ClientData, Tcl_Interp *, int, char ** );
00146 static int   Plfinfo( ClientData, Tcl_Interp *, int, char ** );
00147 static int   KeyEH( ClientData, Tcl_Interp *, int, char ** );
00148 static int   ButtonEH( ClientData, Tcl_Interp *, int, char ** );
00149 static int   LookupTkKeyEvent( PLStream *pls, Tcl_Interp *interp,
00150                                int argc, char **argv );
00151 static int   LookupTkButtonEvent( PLStream *pls, Tcl_Interp *interp,
00152                                   int argc, char **argv );
00153 
00154 static char   *drvoptcmd = NULL;  // tcl command from command line option parsing
00155 
00156 static DrvOpt tk_options[] = { { "tcl_cmd", DRV_STR, &drvoptcmd, "Execute tcl command" },
00157                                { NULL,      DRV_INT, NULL,       NULL                  } };
00158 
00159 void plD_dispatch_init_tk( PLDispatchTable *pdt )
00160 {
00161 #ifndef ENABLE_DYNDRIVERS
00162     pdt->pl_MenuStr = "Tcl/TK Window";
00163     pdt->pl_DevName = "tk";
00164 #endif
00165     pdt->pl_type     = plDevType_Interactive;
00166     pdt->pl_seq      = 7;
00167     pdt->pl_init     = (plD_init_fp) plD_init_tk;
00168     pdt->pl_line     = (plD_line_fp) plD_line_tk;
00169     pdt->pl_polyline = (plD_polyline_fp) plD_polyline_tk;
00170     pdt->pl_eop      = (plD_eop_fp) plD_eop_tk;
00171     pdt->pl_bop      = (plD_bop_fp) plD_bop_tk;
00172     pdt->pl_tidy     = (plD_tidy_fp) plD_tidy_tk;
00173     pdt->pl_state    = (plD_state_fp) plD_state_tk;
00174     pdt->pl_esc      = (plD_esc_fp) plD_esc_tk;
00175 }
00176 
00177 //--------------------------------------------------------------------------
00178 // plD_init_dp()
00179 // plD_init_tk()
00180 // init_tk()
00181 //
00182 // Initialize device.
00183 // TK-dependent stuff done in tk_start().  You can set the display by
00184 // calling plsfnam() with the display name as the (string) argument.
00185 //--------------------------------------------------------------------------
00186 
00187 void
00188 plD_init_tk( PLStream *pls )
00189 {
00190     pls->dp = 0;
00191     plParseDrvOpts( tk_options );
00192     init( pls );
00193 }
00194 
00195 void
00196 plD_init_dp( PLStream *pls )
00197 {
00198 #ifdef PLD_dp
00199     pls->dp = 1;
00200 #else
00201     fprintf( stderr, "The Tcl-DP driver hasn't been installed!\n" );
00202     pls->dp = 0;
00203 #endif
00204     init( pls );
00205 }
00206 
00207 static void
00208 tk_wr_header( PLStream *pls, const char *header )
00209 {
00210     tk_wr( pdf_wr_header( pls->pdfs, header ) );
00211 }
00212 
00213 static void
00214 init( PLStream *pls )
00215 {
00216     U_CHAR c = (U_CHAR) INITIALIZE;
00217     TkDev  *dev;
00218     PLFLT  pxlx, pxly;
00219     int    xmin = 0;
00220     int    xmax = PIXELS_X - 1;
00221     int    ymin = 0;
00222     int    ymax = PIXELS_Y - 1;
00223 
00224     dbug_enter( "plD_init_tk" );
00225 
00226     pls->color         = 1;     // Is a color device
00227     pls->termin        = 1;     // Is an interactive terminal
00228     pls->dev_di        = 1;     // Handle driver interface commands
00229     pls->dev_flush     = 1;     // Handle our own flushes
00230     pls->dev_fill0     = 1;     // Handle solid fills
00231     pls->dev_fill1     = 1;     // Driver handles pattern fills
00232     pls->server_nokill = 1;     // don't kill if ^C
00233     pls->dev_xor       = 1;     // device support xor mode
00234 
00235 // Activate plot buffer. To programmatically save a file we can't call
00236 // plreplot(), but instead one must send a command to plserver. As there is
00237 // no API call for this, the user must use the plserver "save/print" menu
00238 // entries. Activating the plot buffer enables the normal
00239 // plmkstrm/plcpstrm/plreplot/plend1 way of saving plots.
00240 //
00241     pls->plbuf_write = 1;
00242 
00243 // Specify buffer size if not yet set (can be changed by -bufmax option).
00244 // A small buffer works best for socket communication
00245 
00246     if ( pls->bufmax == 0 )
00247     {
00248         if ( pls->dp )
00249             pls->bufmax = 450;
00250         else
00251             pls->bufmax = 3500;
00252     }
00253 
00254 // Allocate and initialize device-specific data
00255 
00256     if ( pls->dev != NULL )
00257         free( (void *) pls->dev );
00258 
00259     pls->dev = calloc( 1, (size_t) sizeof ( TkDev ) );
00260     if ( pls->dev == NULL )
00261         plexit( "plD_init_tk: Out of memory." );
00262 
00263     dev = (TkDev *) pls->dev;
00264 
00265     dev->iodev = (PLiodev *) calloc( 1, (size_t) sizeof ( PLiodev ) );
00266     if ( dev->iodev == NULL )
00267         plexit( "plD_init_tk: Out of memory." );
00268 
00269     dev->exit_eventloop = FALSE;
00270 
00271 // Variables used in querying plserver for events
00272 
00273     dev->instr     = 0;
00274     dev->max_instr = MAX_INSTR;
00275 
00276 // Start interpreter and spawn server process
00277 
00278     tk_start( pls );
00279 
00280 // Get ready for plotting
00281 
00282     dev->xold = PL_UNDEFINED;
00283     dev->yold = PL_UNDEFINED;
00284 
00285 #if PHYSICAL
00286     pxlx = (double) PIXELS_X / dev->width * DPMM;
00287     pxly = (double) PIXELS_Y / dev->height * DPMM;
00288 #else
00289     pxlx = (double) PIXELS_X / LPAGE_X;
00290     pxly = (double) PIXELS_Y / LPAGE_Y;
00291 #endif
00292 
00293     plP_setpxl( pxlx, pxly );
00294     plP_setphy( xmin, xmax, ymin, ymax );
00295 
00296 // Send init info
00297 
00298     tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00299 
00300 // The header and version fields are useful when the client & server
00301 // reside on different machines
00302 
00303     tk_wr_header( pls, PLSERV_HEADER );
00304     tk_wr_header( pls, PLSERV_VERSION );
00305 
00306     tk_wr_header( pls, "xmin" );
00307     tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) xmin ) );
00308 
00309     tk_wr_header( pls, "xmax" );
00310     tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) xmax ) );
00311 
00312     tk_wr_header( pls, "ymin" );
00313     tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) ymin ) );
00314 
00315     tk_wr_header( pls, "ymax" );
00316     tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) ymax ) );
00317 
00318     tk_wr_header( pls, "" );
00319 
00320 // Write color map state info
00321     plD_state_tk( pls, PLSTATE_CMAP0 );
00322     plD_state_tk( pls, PLSTATE_CMAP1 );
00323 
00324 // Good place to make sure the data transfer is working OK
00325 
00326     flush_output( pls );
00327 }
00328 
00329 //--------------------------------------------------------------------------
00330 // plD_line_tk()
00331 //
00332 // Draw a line in the current color from (x1,y1) to (x2,y2).
00333 //--------------------------------------------------------------------------
00334 
00335 void
00336 plD_line_tk( PLStream *pls, short x1, short y1, short x2, short y2 )
00337 {
00338     U_CHAR  c;
00339     U_SHORT xy[4];
00340     TkDev   *dev = (TkDev *) pls->dev;
00341 
00342     CheckForEvents( pls );
00343 
00344     if ( x1 == dev->xold && y1 == dev->yold )
00345     {
00346         c = (U_CHAR) LINETO;
00347         tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00348 
00349         xy[0] = (U_SHORT) x2;
00350         xy[1] = (U_SHORT) y2;
00351         tk_wr( pdf_wr_2nbytes( pls->pdfs, xy, 2 ) );
00352     }
00353     else
00354     {
00355         c = (U_CHAR) LINE;
00356         tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00357 
00358         xy[0] = (U_SHORT) x1;
00359         xy[1] = (U_SHORT) y1;
00360         xy[2] = (U_SHORT) x2;
00361         xy[3] = (U_SHORT) y2;
00362         tk_wr( pdf_wr_2nbytes( pls->pdfs, xy, 4 ) );
00363     }
00364     dev->xold = x2;
00365     dev->yold = y2;
00366 
00367     if ( pls->pdfs->bp > (size_t) pls->bufmax )
00368         flush_output( pls );
00369 }
00370 
00371 //--------------------------------------------------------------------------
00372 // plD_polyline_tk()
00373 //
00374 // Draw a polyline in the current color from (x1,y1) to (x2,y2).
00375 //--------------------------------------------------------------------------
00376 
00377 void
00378 plD_polyline_tk( PLStream *pls, short *xa, short *ya, PLINT npts )
00379 {
00380     U_CHAR c    = (U_CHAR) POLYLINE;
00381     TkDev  *dev = (TkDev *) pls->dev;
00382 
00383     CheckForEvents( pls );
00384 
00385     tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00386     tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) npts ) );
00387 
00388     tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) xa, npts ) );
00389     tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) ya, npts ) );
00390 
00391     dev->xold = xa[npts - 1];
00392     dev->yold = ya[npts - 1];
00393 
00394     if ( pls->pdfs->bp > (size_t) pls->bufmax )
00395         flush_output( pls );
00396 }
00397 
00398 //--------------------------------------------------------------------------
00399 // plD_eop_tk()
00400 //
00401 // End of page.
00402 // User must hit <RETURN> to continue.
00403 //--------------------------------------------------------------------------
00404 
00405 void
00406 plD_eop_tk( PLStream *pls )
00407 {
00408     U_CHAR c = (U_CHAR) EOP;
00409 
00410     dbug_enter( "plD_eop_tk" );
00411 
00412     tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00413     flush_output( pls );
00414     if ( !pls->nopause )
00415         WaitForPage( pls );
00416 }
00417 
00418 //--------------------------------------------------------------------------
00419 // plD_bop_tk()
00420 //
00421 // Set up for the next page.
00422 //--------------------------------------------------------------------------
00423 
00424 void
00425 plD_bop_tk( PLStream *pls )
00426 {
00427     U_CHAR c    = (U_CHAR) BOP;
00428     TkDev  *dev = (TkDev *) pls->dev;
00429 
00430     dbug_enter( "plD_bop_tk" );
00431 
00432     dev->xold = PL_UNDEFINED;
00433     dev->yold = PL_UNDEFINED;
00434     pls->page++;
00435     tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00436 }
00437 
00438 //--------------------------------------------------------------------------
00439 // plD_tidy_tk()
00440 //
00441 // Close graphics file
00442 //--------------------------------------------------------------------------
00443 
00444 void
00445 plD_tidy_tk( PLStream *pls )
00446 {
00447     TkDev *dev = (TkDev *) pls->dev;
00448 
00449     dbug_enter( "plD_tidy_tk" );
00450 
00451     if ( dev != NULL )
00452         tk_stop( pls );
00453 }
00454 
00455 //--------------------------------------------------------------------------
00456 // plD_state_tk()
00457 //
00458 // Handle change in PLStream state (color, pen width, fill attribute, etc).
00459 //--------------------------------------------------------------------------
00460 
00461 void
00462 plD_state_tk( PLStream *pls, PLINT op )
00463 {
00464     U_CHAR c = (U_CHAR) CHANGE_STATE;
00465     int    i;
00466 
00467     dbug_enter( "plD_state_tk" );
00468 
00469     tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00470     tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
00471 
00472     switch ( op )
00473     {
00474     case PLSTATE_WIDTH:
00475         tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) ( pls->width ) ) );
00476         break;
00477 
00478     case PLSTATE_COLOR0:
00479         tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->icol0 ) );
00480 
00481         if ( pls->icol0 == PL_RGB_COLOR )
00482         {
00483             tk_wr( pdf_wr_1byte( pls->pdfs, pls->curcolor.r ) );
00484             tk_wr( pdf_wr_1byte( pls->pdfs, pls->curcolor.g ) );
00485             tk_wr( pdf_wr_1byte( pls->pdfs, pls->curcolor.b ) );
00486         }
00487         break;
00488 
00489     case PLSTATE_COLOR1:
00490         tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->icol1 ) );
00491         break;
00492 
00493     case PLSTATE_FILL:
00494         tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) pls->patt ) );
00495         break;
00496 
00497     case PLSTATE_CMAP0:
00498         tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->ncol0 ) );
00499         for ( i = 0; i < pls->ncol0; i++ )
00500         {
00501             tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap0[i].r ) );
00502             tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap0[i].g ) );
00503             tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap0[i].b ) );
00504         }
00505         break;
00506 
00507     case PLSTATE_CMAP1:
00508         tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->ncol1 ) );
00509         for ( i = 0; i < pls->ncol1; i++ )
00510         {
00511             tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap1[i].r ) );
00512             tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap1[i].g ) );
00513             tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap1[i].b ) );
00514         }
00515         // Need to send over the control points too!
00516         tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->ncp1 ) );
00517         for ( i = 0; i < pls->ncp1; i++ )
00518         {
00519             tk_wr( pdf_wr_ieeef( pls->pdfs, (float) pls->cmap1cp[i].h ) );
00520             tk_wr( pdf_wr_ieeef( pls->pdfs, (float) pls->cmap1cp[i].l ) );
00521             tk_wr( pdf_wr_ieeef( pls->pdfs, (float) pls->cmap1cp[i].s ) );
00522             tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) pls->cmap1cp[i].alt_hue_path ) );
00523         }
00524         break;
00525     }
00526 
00527     if ( pls->pdfs->bp > (size_t) pls->bufmax )
00528         flush_output( pls );
00529 }
00530 
00531 //--------------------------------------------------------------------------
00532 // plD_esc_tk()
00533 //
00534 // Escape function.
00535 // Functions:
00536 //
00537 //      PLESC_EXPOSE    Force an expose (just passes token)
00538 //      PLESC_RESIZE    Force a resize (just passes token)
00539 //      PLESC_REDRAW    Force a redraw
00540 //      PLESC_FLUSH     Flush X event buffer
00541 //      PLESC_FILL      Fill polygon
00542 //      PLESC_EH        Handle events only
00543 //      PLESC_XORMOD    Xor mode
00544 //
00545 //--------------------------------------------------------------------------
00546 
00547 void
00548 plD_esc_tk( PLStream *pls, PLINT op, void *ptr )
00549 {
00550     U_CHAR c = (U_CHAR) ESCAPE;
00551 
00552     dbug_enter( "plD_esc_tk" );
00553 
00554     switch ( op )
00555     {
00556     case PLESC_DI:
00557         tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00558         tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
00559         tk_di( pls );
00560         break;
00561 
00562     case PLESC_EH:
00563         tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00564         tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
00565         HandleEvents( pls );
00566         break;
00567 
00568     case PLESC_FLUSH:
00569         tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00570         tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
00571         flush_output( pls );
00572         break;
00573 
00574     case PLESC_FILL:
00575         tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00576         tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
00577         tk_fill( pls );
00578         break;
00579 
00580     case PLESC_GETC:
00581         GetCursor( pls, (PLGraphicsIn *) ptr );
00582         break;
00583 
00584     case PLESC_XORMOD:
00585         tk_XorMod( pls, (PLINT *) ptr );
00586         break;
00587 
00588     default:
00589         tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
00590         tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
00591     }
00592 }
00593 
00594 //--------------------------------------------------------------------------
00595 // tk_XorMod()
00596 //
00597 // enter (mod = 1) or leave (mod = 0) xor mode
00598 //
00599 //--------------------------------------------------------------------------
00600 
00601 static void
00602 tk_XorMod( PLStream *pls, PLINT *ptr )
00603 {
00604     if ( *ptr != 0 )
00605         server_cmd( pls, "$plwidget cmd plxormod 1 st", 1 );
00606     else
00607         server_cmd( pls, "$plwidget cmd plxormod 0 st", 1 );
00608 }
00609 
00610 
00611 //--------------------------------------------------------------------------
00612 // GetCursor()
00613 //
00614 // Waits for a graphics input event and returns coordinates.
00615 //--------------------------------------------------------------------------
00616 
00617 static void
00618 GetCursor( PLStream *pls, PLGraphicsIn *ptr )
00619 {
00620     TkDev        *dev = (TkDev *) pls->dev;
00621     PLGraphicsIn *gin = &( dev->gin );
00622 
00623 // Initialize
00624 
00625     plGinInit( gin );
00626     dev->locate_mode = LOCATE_INVOKED_VIA_API;
00627     plD_esc_tk( pls, PLESC_FLUSH, NULL );
00628     server_cmd( pls, "$plwidget configure -xhairs on", 1 );
00629 
00630 // Run event loop until a point is selected
00631 
00632     while ( gin->pX < 0 && dev->locate_mode )
00633     {
00634         Tk_DoOneEvent( 0 );
00635     }
00636 
00637 // Clean up
00638 
00639     server_cmd( pls, "$plwidget configure -xhairs off", 1 );
00640     *ptr = *gin;
00641 }
00642 
00643 //--------------------------------------------------------------------------
00644 // tk_di
00645 //
00646 // Process driver interface command.
00647 // Just send the command to the remote PLplot library.
00648 //--------------------------------------------------------------------------
00649 
00650 static void
00651 tk_di( PLStream *pls )
00652 {
00653     TkDev *dev = (TkDev *) pls->dev;
00654     char  str[STR_LEN];
00655 
00656     dbug_enter( "tk_di" );
00657 
00658 // Safety feature, should never happen
00659 
00660     if ( dev == NULL )
00661     {
00662         plabort( "tk_di: Illegal call to driver (not yet initialized)" );
00663         return;
00664     }
00665 
00666 // Flush the buffer before proceeding
00667 
00668     flush_output( pls );
00669 
00670 // Change orientation
00671 
00672     if ( pls->difilt & PLDI_ORI )
00673     {
00674         snprintf( str, STR_LEN, "%f", pls->diorot );
00675         Tcl_SetVar( dev->interp, "rot", str, 0 );
00676 
00677         server_cmd( pls, "$plwidget cmd plsetopt -ori $rot", 1 );
00678         pls->difilt &= ~PLDI_ORI;
00679     }
00680 
00681 // Change window into plot space
00682 
00683     if ( pls->difilt & PLDI_PLT )
00684     {
00685         snprintf( str, STR_LEN, "%f", pls->dipxmin );
00686         Tcl_SetVar( dev->interp, "xl", str, 0 );
00687         snprintf( str, STR_LEN, "%f", pls->dipymin );
00688         Tcl_SetVar( dev->interp, "yl", str, 0 );
00689         snprintf( str, STR_LEN, "%f", pls->dipxmax );
00690         Tcl_SetVar( dev->interp, "xr", str, 0 );
00691         snprintf( str, STR_LEN, "%f", pls->dipymax );
00692         Tcl_SetVar( dev->interp, "yr", str, 0 );
00693 
00694         server_cmd( pls, "$plwidget cmd plsetopt -wplt $xl,$yl,$xr,$yr", 1 );
00695         pls->difilt &= ~PLDI_PLT;
00696     }
00697 
00698 // Change window into device space
00699 
00700     if ( pls->difilt & PLDI_DEV )
00701     {
00702         snprintf( str, STR_LEN, "%f", pls->mar );
00703         Tcl_SetVar( dev->interp, "mar", str, 0 );
00704         snprintf( str, STR_LEN, "%f", pls->aspect );
00705         Tcl_SetVar( dev->interp, "aspect", str, 0 );
00706         snprintf( str, STR_LEN, "%f", pls->jx );
00707         Tcl_SetVar( dev->interp, "jx", str, 0 );
00708         snprintf( str, STR_LEN, "%f", pls->jy );
00709         Tcl_SetVar( dev->interp, "jy", str, 0 );
00710 
00711         server_cmd( pls, "$plwidget cmd plsetopt -mar $mar", 1 );
00712         server_cmd( pls, "$plwidget cmd plsetopt -a $aspect", 1 );
00713         server_cmd( pls, "$plwidget cmd plsetopt -jx $jx", 1 );
00714         server_cmd( pls, "$plwidget cmd plsetopt -jy $jy", 1 );
00715         pls->difilt &= ~PLDI_DEV;
00716     }
00717 
00718 // Update view
00719 
00720     server_cmd( pls, "update", 1 );
00721     server_cmd( pls, "plw::update_view $plwindow", 1 );
00722 }
00723 
00724 //--------------------------------------------------------------------------
00725 // tk_fill()
00726 //
00727 // Fill polygon described in points pls->dev_x[] and pls->dev_y[].
00728 //--------------------------------------------------------------------------
00729 
00730 static void
00731 tk_fill( PLStream *pls )
00732 {
00733     PLDev *dev = (PLDev *) pls->dev;
00734 
00735     dbug_enter( "tk_fill" );
00736 
00737     tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->dev_npts ) );
00738 
00739     tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) pls->dev_x, pls->dev_npts ) );
00740     tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) pls->dev_y, pls->dev_npts ) );
00741 
00742     dev->xold = PL_UNDEFINED;
00743     dev->yold = PL_UNDEFINED;
00744 }
00745 
00746 //--------------------------------------------------------------------------
00747 // tk_start
00748 //
00749 // Create TCL interpreter and spawn off server process.
00750 // Each stream that uses the tk driver gets its own interpreter.
00751 //--------------------------------------------------------------------------
00752 
00753 static void
00754 tk_start( PLStream *pls )
00755 {
00756     TkDev *dev = (TkDev *) pls->dev;
00757 
00758     dbug_enter( "tk_start" );
00759 
00760 // Instantiate a TCL interpreter, and get rid of the exec command
00761 
00762     dev->interp = Tcl_CreateInterp();
00763 
00764     if ( Tcl_Init( dev->interp ) != TCL_OK )
00765     {
00766         fprintf( stderr, "%s\n", Tcl_GetStringResult( dev->interp ) );
00767         abort_session( pls, "Unable to initialize Tcl" );
00768     }
00769 
00770     tcl_cmd( pls, "rename exec {}" );
00771 
00772 // Set top level window name & initialize
00773 
00774     set_windowname( pls );
00775     if ( pls->dp )
00776     {
00777         Tcl_SetVar( dev->interp, "dp", "1", TCL_GLOBAL_ONLY );
00778         dev->updatecmd = "dp_update";
00779     }
00780     else
00781     {
00782         Tcl_SetVar( dev->interp, "dp", "0", TCL_GLOBAL_ONLY );
00783 
00784         // tk_init needs this. Use pls->FileName first, then DISPLAY, then :0.0
00785 
00786         if ( pls->FileName != NULL )
00787             Tcl_SetVar2( dev->interp, "env", "DISPLAY", pls->FileName, TCL_GLOBAL_ONLY );
00788         else if ( getenv( "DISPLAY" ) != NULL )
00789             Tcl_SetVar2( dev->interp, "env", "DISPLAY", getenv( "DISPLAY" ), TCL_GLOBAL_ONLY ); // tk_init need this
00790         else
00791             Tcl_SetVar2( dev->interp, "env", "DISPLAY", "unix:0.0", TCL_GLOBAL_ONLY );          // tk_init need this
00792 
00793         dev->updatecmd = "update";
00794         if ( pltk_toplevel( &dev->w, dev->interp ) )
00795             abort_session( pls, "Unable to create top-level window" );
00796     }
00797 
00798 // Eval startup procs
00799 
00800     if ( pltkdriver_Init( pls ) != TCL_OK )
00801     {
00802         abort_session( pls, "" );
00803     }
00804 
00805     if ( pls->debug )
00806         tcl_cmd( pls, "global auto_path; puts \"auto_path: $auto_path\"" );
00807 
00808 // Other initializations.
00809 // Autoloaded, so the user can customize it if desired
00810 
00811     tcl_cmd( pls, "plclient_init" );
00812 
00813 // A different way to customize the interface.
00814 // E.g. used by plrender to add a back page button.
00815 
00816     if ( drvoptcmd )
00817         tcl_cmd( pls, drvoptcmd );
00818 
00819 // Initialize server process
00820 
00821     init_server( pls );
00822 
00823 // By now we should be done with all autoloaded procs, so blow away
00824 // the open command just in case security has been compromised
00825 
00826     tcl_cmd( pls, "rename open {}" );
00827     tcl_cmd( pls, "rename rename {}" );
00828 
00829 // Initialize widgets
00830 
00831     plwindow_init( pls );
00832 
00833 // Initialize data link
00834 
00835     link_init( pls );
00836 
00837     return;
00838 }
00839 
00840 //--------------------------------------------------------------------------
00841 // tk_stop
00842 //
00843 // Normal termination & cleanup.
00844 //--------------------------------------------------------------------------
00845 
00846 static void
00847 tk_stop( PLStream *pls )
00848 {
00849     TkDev *dev = (TkDev *) pls->dev;
00850 
00851     dbug_enter( "tk_stop" );
00852 
00853 // Safety check for out of control code
00854 
00855     if ( dev->pass_thru )
00856         return;
00857 
00858     dev->pass_thru = 1;
00859 
00860 // Kill plserver
00861 
00862     tcl_cmd( pls, "plclient_link_end" );
00863 
00864 // Wait for child process to complete
00865 
00866     if ( dev->child_pid )
00867     {
00868         waitpid( dev->child_pid, NULL, 0 );
00869 //
00870 //      problems if parent has not caught/ignore SIGCHLD. Returns -1 and errno=EINTR
00871 //      if (waitpid(dev->child_pid, NULL, 0) != dev->child_pid)
00872 //          fprintf(stderr, "tk_stop: waidpid error");
00873 //
00874     }
00875 
00876 // Blow away interpreter
00877 
00878     Tcl_DeleteInterp( dev->interp );
00879     dev->interp = NULL;
00880 
00881 // Free up memory and other miscellanea
00882 
00883     pdf_close( pls->pdfs );
00884     if ( dev->iodev != NULL )
00885     {
00886         if ( dev->iodev->file != NULL )
00887             plCloseFile( pls );
00888 
00889         free( (void *) dev->iodev );
00890     }
00891     free_mem( dev->cmdbuf );
00892 }
00893 
00894 //--------------------------------------------------------------------------
00895 // abort_session
00896 //
00897 // Terminates with an error.
00898 // Cleanup is done here, and once pls->level is cleared the driver will
00899 // never be called again.
00900 //--------------------------------------------------------------------------
00901 
00902 static void
00903 abort_session( PLStream *pls, const char *msg )
00904 {
00905     TkDev *dev = (TkDev *) pls->dev;
00906 
00907     dbug_enter( "abort_session" );
00908 
00909 // Safety check for out of control code
00910 
00911     if ( dev->pass_thru )
00912         return;
00913 
00914     tk_stop( pls );
00915     pls->level = 0;
00916 
00917     plexit( msg );
00918 }
00919 
00920 //--------------------------------------------------------------------------
00921 // pltkdriver_Init
00922 //
00923 // Performs PLplot/TK driver-specific Tcl initialization.
00924 //--------------------------------------------------------------------------
00925 
00926 static int
00927 pltkdriver_Init( PLStream *pls )
00928 {
00929     TkDev      *dev    = (TkDev *) pls->dev;
00930     Tcl_Interp *interp = (Tcl_Interp *) dev->interp;
00931 
00932 //
00933 // Call the init procedures for included packages.  Each call should
00934 // look like this:
00935 //
00936 // if (Mod_Init(interp) == TCL_ERROR) {
00937 //     return TCL_ERROR;
00938 // }
00939 //
00940 // where "Mod" is the name of the module.
00941 //
00942 
00943     if ( Tcl_Init( interp ) == TCL_ERROR )
00944     {
00945         return TCL_ERROR;
00946     }
00947 #ifdef PLD_dp
00948     if ( pls->dp )
00949     {
00950         if ( Tdp_Init( interp ) == TCL_ERROR )
00951         {
00952             return TCL_ERROR;
00953         }
00954     }
00955 #endif
00956 
00957 //
00958 // Call Tcl_CreateCommand for application-specific commands, if
00959 // they weren't already created by the init procedures called above.
00960 //
00961 
00962     Tcl_CreateCommand( interp, "wait_until", (Tcl_CmdProc *) plWait_Until,
00963         (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
00964 
00965 #ifdef PLD_dp
00966     if ( pls->dp )
00967     {
00968         Tcl_CreateCommand( interp, "host_id", (Tcl_CmdProc *) plHost_ID,
00969             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
00970     }
00971 #endif
00972 
00973     Tcl_CreateCommand( interp, "abort", (Tcl_CmdProc *) Abort,
00974         (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
00975 
00976     Tcl_CreateCommand( interp, "plfinfo", (Tcl_CmdProc *) Plfinfo,
00977         (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
00978 
00979     Tcl_CreateCommand( interp, "keypress", (Tcl_CmdProc *) KeyEH,
00980         (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
00981 
00982     Tcl_CreateCommand( interp, "buttonpress", (Tcl_CmdProc *) ButtonEH,
00983         (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
00984 
00985 // Set some relevant interpreter variables
00986 
00987     if ( !pls->dp )
00988         tcl_cmd( pls, "set client_name [winfo name .]" );
00989 
00990     if ( pls->server_name != NULL )
00991         Tcl_SetVar( interp, "server_name", pls->server_name, 0 );
00992 
00993     if ( pls->server_host != NULL )
00994         Tcl_SetVar( interp, "server_host", pls->server_host, 0 );
00995 
00996     if ( pls->server_port != NULL )
00997         Tcl_SetVar( interp, "server_port", pls->server_port, 0 );
00998 
00999 // Set up auto_path
01000 
01001     if ( pls_auto_path( interp ) == TCL_ERROR )
01002         return TCL_ERROR;
01003 
01004     return TCL_OK;
01005 }
01006 
01007 //--------------------------------------------------------------------------
01008 // init_server
01009 //
01010 // Starts interaction with server process, launching it if necessary.
01011 //
01012 // There are several possibilities we must account for, depending on the
01013 // message protocol, input flags, and whether plserver is already running
01014 // or not.  From the point of view of the code, they are:
01015 //
01016 //    1. Driver: tk
01017 //       Flags: <none>
01018 //       Meaning: need to start up plserver (same host)
01019 //       Actions: fork plserver, passing it our TK main window name
01020 //                for communication.  Once started, plserver will send
01021 //                back its main window name.
01022 //
01023 //    2. Driver: dp
01024 //       Flags: <none>
01025 //       Meaning: need to start up plserver (same host)
01026 //       Actions: fork plserver, passing it our Tcl-DP communication port
01027 //                for communication. Once started, plserver will send
01028 //                back its created message port number.
01029 //
01030 //    3. Driver: tk
01031 //       Flags: -server_name
01032 //       Meaning: plserver already running (same host)
01033 //       Actions: communicate to plserver our TK main window name.
01034 //
01035 //    4. Driver: dp
01036 //       Flags: -server_port
01037 //       Meaning: plserver already running (same host)
01038 //       Actions: communicate to plserver our Tcl-DP port number.
01039 //
01040 //    5. Driver: dp
01041 //       Flags: -server_host
01042 //       Meaning: need to start up plserver (remote host)
01043 //       Actions: rsh (remsh) plserver, passing it our host ID and Tcl-DP
01044 //                port for communication. Once started, plserver will send
01045 //                back its created message port number.
01046 //
01047 //    6. Driver: dp
01048 //       Flags: -server_host -server_port
01049 //       Meaning: plserver already running (remote host)
01050 //       Actions: communicate to remote plserver our host ID and Tcl-DP
01051 //                port number.
01052 //
01053 // For a bit more flexibility, you can change the name of the process
01054 // invoked from "plserver" to something else, using the -plserver flag.
01055 //
01056 // The startup procedure involves some rather involved handshaking between
01057 // client and server.  This is made easier by using the Tcl variables:
01058 //
01059 //      client_host client_port server_host server_port
01060 //
01061 // when using Tcl-DP sends and
01062 //
01063 //      client_name server_name
01064 //
01065 // when using TK sends.  The global Tcl variables
01066 //
01067 //      client server
01068 //
01069 // are used as the defining identification for the client and server
01070 // respectively -- they denote the main window name when TK sends are used
01071 // and the respective process's listening socket when Tcl-DP sends are
01072 // used.  Note that in the former case, $client is just the same as
01073 // $client_name.  In addition, since the server may need to communicate
01074 // with many different client processes, every command to the server
01075 // contains the sender's client id (so it knows how to report back if
01076 // necessary).  Thus the Tk driver's interpreter must know both $server as
01077 // well as $client.  It is most convenient to set $client from the server,
01078 // as a way to signal that communication has been set up and it is safe to
01079 // proceed.
01080 //
01081 // Often it is necessary to use constructs such as [list $server] instead
01082 // of just $server.  This occurs since you could have multiple copies
01083 // running on the display (resulting in names of the form "plserver #2",
01084 // etc).  Embedding such a string in a "[list ...]" construct prevents the
01085 // string from being interpreted as two separate strings.
01086 //--------------------------------------------------------------------------
01087 
01088 static void
01089 init_server( PLStream *pls )
01090 {
01091     int server_exists = 0;
01092 
01093     dbug_enter( "init_server" );
01094 
01095     pldebug( "init_server", "%s -- PID: %d, PGID: %d, PPID: %d\n",
01096         __FILE__, (int) getpid(), (int) getpgrp(), (int) getppid() );
01097 
01098 // If no means of communication provided, need to launch plserver
01099 
01100     if ( ( !pls->dp && pls->server_name != NULL ) ||
01101          ( pls->dp && pls->server_port != NULL ) )
01102         server_exists = 1;
01103 
01104 // So launch it
01105 
01106     if ( !server_exists )
01107         launch_server( pls );
01108 
01109 // Set up communication channel to server
01110 
01111     if ( pls->dp )
01112     {
01113         tcl_cmd( pls,
01114             "set server [dp_MakeRPCClient $server_host $server_port]" );
01115     }
01116     else
01117     {
01118         tcl_cmd( pls, "set server $server_name" );
01119     }
01120 
01121 // If server didn't need launching, contact it here
01122 
01123     if ( server_exists )
01124         tcl_cmd( pls, "plclient_link_init" );
01125 }
01126 
01127 //--------------------------------------------------------------------------
01128 // launch_server
01129 //
01130 // Launches plserver, locally or remotely.
01131 //--------------------------------------------------------------------------
01132 
01133 static void
01134 launch_server( PLStream *pls )
01135 {
01136     TkDev      *dev = (TkDev *) pls->dev;
01137     const char *argv[20];
01138     char       *plserver_exec = NULL, *ptr;
01139     char       *tmp           = NULL;
01140     int        i;
01141 
01142     dbug_enter( "launch_server" );
01143 
01144     if ( pls->plserver == NULL )
01145         pls->plserver = plstrdup( "plserver" );
01146 
01147 // Build argument list
01148 
01149     i = 0;
01150 
01151 // If we're doing a rsh, need to set up its arguments first.
01152 
01153     if ( pls->dp && pls->server_host != NULL )
01154     {
01155         argv[i++] = pls->server_host;   // Host name for rsh
01156 
01157         if ( pls->user != NULL )
01158         {
01159             argv[i++] = "-l";
01160             argv[i++] = pls->user;      // User name on remote node
01161         }
01162     }
01163 
01164 // The invoked executable name comes next
01165 
01166     argv[i++] = pls->plserver;
01167 
01168 // The rest are arguments to plserver
01169 
01170     argv[i++] = "-child";               // Tell plserver its ancestry
01171 
01172     argv[i++] = "-e";                   // Startup script
01173     argv[i++] = "plserver_init";
01174 
01175 // aaahhh. This is it! Without the next statements, control is either
01176 // in tk or octave, because tcl/tk was in interative mode (I think).
01177 // This had the inconvenient of having to press the enter key or cliking a
01178 // mouse button in the plot window after every plot.
01179 //
01180 // This couldn't be done with
01181 //      Tcl_SetVar(dev->interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
01182 // after plserver has been launched? It doesnt work, hoewever.
01183 // Tk_CreateFileHandler (0, TK_READABLE, NULL, 0) doesnt work also
01184 //
01185 
01186     argv[i++] = "-file";                        // Startup file
01187     if ( pls->tk_file )
01188         argv[i++] = pls->tk_file;
01189     else
01190         argv[i++] = "/dev/null";
01191 
01192 
01193 //
01194 // Give interpreter the base name of the plwindow.
01195 // Useful to know the interpreter name
01196 //
01197 
01198     if ( pls->plwindow != NULL )
01199     {
01200         char *t;
01201         argv[i++] = "-name";                       // plserver name
01202         tmp       = plstrdup( pls->plwindow + 1 ); // get rid of the initial dot
01203         argv[i++] = tmp;
01204         if ( ( t = strchr( tmp, '.' ) ) != NULL )
01205             *t = '\0';                  // and keep only the base name
01206     }
01207     else
01208     {
01209         argv[i++] = "-name";            // plserver name
01210         argv[i++] = pls->program;
01211     }
01212 
01213     if ( pls->auto_path != NULL )
01214     {
01215         argv[i++] = "-auto_path";       // Additional directory(s)
01216         argv[i++] = pls->auto_path;     // to autoload
01217     }
01218 
01219     if ( pls->geometry != NULL )
01220     {
01221         argv[i++] = "-geometry";        // Top level window geometry
01222         argv[i++] = pls->geometry;
01223     }
01224 
01225 // If communicating via Tcl-DP, specify communications port id
01226 // If communicating via TK send, specify main window name
01227 
01228     if ( pls->dp )
01229     {
01230         argv[i++] = "-client_host";
01231         argv[i++] = Tcl_GetVar( dev->interp, "client_host", TCL_GLOBAL_ONLY );
01232 
01233         argv[i++] = "-client_port";
01234         argv[i++] = Tcl_GetVar( dev->interp, "client_port", TCL_GLOBAL_ONLY );
01235 
01236         if ( pls->user != NULL )
01237         {
01238             argv[i++] = "-l";
01239             argv[i++] = pls->user;
01240         }
01241     }
01242     else
01243     {
01244         argv[i++] = "-client_name";
01245         argv[i++] = Tcl_GetVar( dev->interp, "client_name", TCL_GLOBAL_ONLY );
01246     }
01247 
01248 // The display absolutely must be set if invoking a remote server (by rsh)
01249 // Use the DISPLAY environmental, if set.  Otherwise use the remote host.
01250 
01251     if ( pls->FileName != NULL )
01252     {
01253         argv[i++] = "-display";
01254         argv[i++] = pls->FileName;
01255     }
01256     else if ( pls->dp && pls->server_host != NULL )
01257     {
01258         argv[i++] = "-display";
01259         if ( ( ptr = getenv( "DISPLAY" ) ) != NULL )
01260             argv[i++] = ptr;
01261         else
01262             argv[i++] = "unix:0.0";
01263     }
01264 
01265 // Add terminating null
01266 
01267     argv[i++] = NULL;
01268 #ifdef DEBUG
01269     if ( pls->debug )
01270     {
01271         int j;
01272         fprintf( stderr, "argument list: \n   " );
01273         for ( j = 0; j < i; j++ )
01274             fprintf( stderr, "%s ", argv[j] );
01275         fprintf( stderr, "\n" );
01276     }
01277 #endif
01278 
01279 // Start server process
01280 // It's a fork/rsh if on a remote machine
01281 
01282     if ( pls->dp && pls->server_host != NULL )
01283     {
01284         if ( ( dev->child_pid = fork() ) < 0 )
01285         {
01286             abort_session( pls, "Unable to fork server process" );
01287         }
01288         else if ( dev->child_pid == 0 )
01289         {
01290             fprintf( stderr, "Starting up %s on node %s\n", pls->plserver,
01291                 pls->server_host );
01292 
01293             if ( execvp( "rsh", (char * const *) argv ) )
01294             {
01295                 perror( "Unable to exec server process" );
01296                 _exit( 1 );
01297             }
01298         }
01299     }
01300 
01301 // Running locally, so its a fork/exec
01302 
01303     else
01304     {
01305         plserver_exec = plFindCommand( pls->plserver );
01306         if ( ( plserver_exec == NULL ) || ( dev->child_pid = fork() ) < 0 )
01307         {
01308             abort_session( pls, "Unable to fork server process" );
01309         }
01310         else if ( dev->child_pid == 0 )
01311         {
01312             // Don't kill plserver on a ^C if pls->server_nokill is set
01313 
01314             if ( pls->server_nokill )
01315             {
01316                 sigset_t set;
01317                 sigemptyset( &set );
01318                 sigaddset( &set, SIGINT );
01319                 if ( sigprocmask( SIG_BLOCK, &set, 0 ) < 0 )
01320                     fprintf( stderr, "PLplot: sigprocmask failure\n" );
01321             }
01322 
01323             pldebug( "launch_server", "Starting up %s\n", plserver_exec );
01324             if ( execv( plserver_exec, (char * const *) argv ) )
01325             {
01326                 fprintf( stderr, "Unable to exec server process.\n" );
01327                 _exit( 1 );
01328             }
01329         }
01330         free_mem( plserver_exec );
01331     }
01332     free_mem( tmp );
01333 
01334 // Wait for server to set up return communication channel
01335 
01336     tk_wait( pls, "[info exists client]" );
01337 }
01338 
01339 //--------------------------------------------------------------------------
01340 // plwindow_init
01341 //
01342 // Configures the widget hierarchy we are sending the data stream to.
01343 //
01344 // If a widget name (identifying the actual widget or a container widget)
01345 // hasn't been supplied already we assume it needs to be created.
01346 //
01347 // In order to achieve maximum flexibility, the PLplot tk driver requires
01348 // only that certain TCL procs must be defined in the server interpreter.
01349 // These can be used to set up the desired widget configuration.  The procs
01350 // invoked from this driver currently include:
01351 //
01352 //    $plw_create_proc          Creates the widget environment
01353 //    $plw_start_proc           Does any remaining startup necessary
01354 //    $plw_end_proc             Prepares for shutdown
01355 //    $plw_flash_proc           Invoked when waiting for page advance
01356 //
01357 // Since all of these are interpreter variables, they can be trivially
01358 // changed by the user.
01359 //
01360 // Each of these utility procs is called with a widget name ($plwindow)
01361 // as argument.  "plwindow" is set from the value of pls->plwindow, and
01362 // if null is generated from the name of the client main window (to
01363 // ensure uniqueness).  $plwindow usually indicates the container frame
01364 // for the actual PLplot widget, but can be arbitrary -- as long as the
01365 // usage in all the TCL procs is consistent.
01366 //
01367 // In order that the TK driver be able to invoke the actual PLplot
01368 // widget, the proc "$plw_create_proc" deposits the widget name in the local
01369 // interpreter variable "plwidget".
01370 //--------------------------------------------------------------------------
01371 
01372 static void
01373 plwindow_init( PLStream *pls )
01374 {
01375     TkDev        *dev = (TkDev *) pls->dev;
01376     char         command[CMD_LEN];
01377     unsigned int bg;
01378     char         *tmp;
01379     int          i, n;
01380 
01381     dbug_enter( "plwindow_init" );
01382 
01383     // Set tcl plwindow variable to be pls->plwindow with a . prepended and
01384     // and with ' ' replaced by '_' and all other '.' by '_' to avoid
01385     // quoting and bad window name problems. Also avoid name starting with
01386     // an upper case letter.
01387     n   = (int) strlen( pls->plwindow ) + 1;
01388     tmp = (char *) malloc( sizeof ( char ) * (size_t) ( n + 1 ) );
01389     sprintf( tmp, ".%s", pls->plwindow );
01390     for ( i = 1; i < n; i++ )
01391     {
01392         if ( ( tmp[i] == ' ' ) || ( tmp[i] == '.' ) )
01393             tmp[i] = '_';
01394     }
01395     if ( isupper( tmp[1] ) )
01396         tmp[1] = tolower( tmp[1] );
01397     Tcl_SetVar( dev->interp, "plwindow", tmp, 0 );
01398     free( tmp );
01399 
01400 // Create the plframe widget & anything else you want with it.
01401 
01402     server_cmd( pls,
01403         "$plw_create_proc $plwindow [list $client]", 1 );
01404 
01405     tk_wait( pls, "[info exists plwidget]" );
01406 
01407 // Now we should have the actual PLplot widget name in $plwidget
01408 // Configure remote PLplot stream.
01409 
01410 // Configure background color if anything other than black
01411 // The default color is handled from a resource setting in plconfig.tcl
01412 
01413     bg = (unsigned int) ( pls->cmap0[0].b | ( pls->cmap0[0].g << 8 ) | ( pls->cmap0[0].r << 16 ) );
01414     if ( bg > 0 )
01415     {
01416         snprintf( command, CMD_LEN, "$plwidget configure -plbg #%06x", bg );
01417         server_cmd( pls, command, 0 );
01418     }
01419 
01420 // nopixmap option
01421 
01422     if ( pls->nopixmap )
01423         server_cmd( pls, "$plwidget cmd plsetopt -nopixmap", 0 );
01424 
01425 // debugging
01426 
01427     if ( pls->debug )
01428         server_cmd( pls, "$plwidget cmd plsetopt -debug", 0 );
01429 
01430 // double buffering
01431 
01432     if ( pls->db )
01433         server_cmd( pls, "$plwidget cmd plsetopt -db", 0 );
01434 
01435 // color map options
01436 
01437     if ( pls->ncol0 )
01438     {
01439         snprintf( command, CMD_LEN, "$plwidget cmd plsetopt -ncol0 %d", pls->ncol0 );
01440         server_cmd( pls, command, 0 );
01441     }
01442 
01443     if ( pls->ncol1 )
01444     {
01445         snprintf( command, CMD_LEN, "$plwidget cmd plsetopt -ncol1 %d", pls->ncol1 );
01446         server_cmd( pls, command, 0 );
01447     }
01448 
01449 // Start up remote PLplot
01450 
01451     server_cmd( pls, "$plw_start_proc $plwindow", 1 );
01452     tk_wait( pls, "[info exists widget_is_ready]" );
01453 }
01454 
01455 //--------------------------------------------------------------------------
01456 // set_windowname
01457 //
01458 // Set up top level window name.  Use pls->program, modified appropriately.
01459 //--------------------------------------------------------------------------
01460 
01461 static void
01462 set_windowname( PLStream *pls )
01463 {
01464     const char *pname;
01465     int        i;
01466     size_t     maxlen;
01467 
01468     // Set to "plclient" if not initialized via plargs or otherwise
01469 
01470     if ( pls->program == NULL )
01471         pls->program = plstrdup( "plclient" );
01472 
01473     // Eliminate any leading path specification
01474 
01475     pname = strrchr( pls->program, '/' );
01476     if ( pname )
01477         pname++;
01478     else
01479         pname = pls->program;
01480 
01481     if ( pls->plwindow == NULL ) // dont override -plwindow cmd line option
01482     {
01483         maxlen        = strlen( pname ) + 10;
01484         pls->plwindow = (char *) malloc( maxlen * sizeof ( char ) );
01485 
01486         // Allow for multiple widgets created by multiple streams
01487 
01488         if ( pls->ipls == 0 )
01489             snprintf( pls->plwindow, maxlen, ".%s", pname );
01490         else
01491             snprintf( pls->plwindow, maxlen, ".%s_%d", pname, (int) pls->ipls );
01492 
01493         // Replace any ' 's with '_'s to avoid quoting problems.
01494         // Replace any '.'s (except leading) with '_'s to avoid bad window names.
01495 
01496         for ( i = 0; i < (int) strlen( pls->plwindow ); i++ )
01497         {
01498             if ( pls->plwindow[i] == ' ' )
01499                 pls->plwindow[i] = '_';
01500             if ( i == 0 )
01501                 continue;
01502             if ( pls->plwindow[i] == '.' )
01503                 pls->plwindow[i] = '_';
01504         }
01505     }
01506 }
01507 
01508 //--------------------------------------------------------------------------
01509 // link_init
01510 //
01511 // Initializes the link between the client and the PLplot widget for
01512 // data transfer.  Defaults to a FIFO when the TK driver is selected and
01513 // a socket when the DP driver is selected.
01514 //--------------------------------------------------------------------------
01515 
01516 static void
01517 link_init( PLStream *pls )
01518 {
01519     TkDev      *dev     = (TkDev *) pls->dev;
01520     PLiodev    *iodev   = (PLiodev *) dev->iodev;
01521     size_t     bufmax   = (size_t) ( pls->bufmax * 1.2 );
01522     const char *dirname = NULL;
01523 
01524     dbug_enter( "link_init" );
01525 
01526 // Create FIFO for data transfer to the plframe widget
01527 
01528     if ( !pls->dp )
01529     {
01530         // This uses the pl_create_tempfifo function to create
01531         // the fifo in a safe manner by first creating a private
01532         // temporary directory.
01533         iodev->fileName = pl_create_tempfifo( (const char **) &iodev->fileName, &dirname );
01534         if ( dirname == NULL || iodev->fileName == NULL )
01535             abort_session( pls, "mkfifo error" );
01536 
01537         // Tell plframe widget to open FIFO (for reading).
01538 
01539         Tcl_SetVar( dev->interp, "fifoname", iodev->fileName, 0 );
01540         server_cmd( pls, "$plwidget openlink fifo $fifoname", 1 );
01541 
01542         // Open the FIFO for writing
01543         // This will block until the server opens it for reading
01544 
01545         if ( ( iodev->fd = open( iodev->fileName, O_WRONLY ) ) == -1 )
01546             abort_session( pls, "Error opening fifo for write" );
01547 
01548         // Create stream interface (C file handle) to FIFO
01549 
01550         iodev->type     = 0;
01551         iodev->typeName = "fifo";
01552         iodev->file     = fdopen( iodev->fd, "wb" );
01553 
01554 // Unlink FIFO so that it isn't left around if program crashes.
01555 // This also ensures no other program can mess with it.
01556 
01557         if ( unlink( iodev->fileName ) == -1 )
01558             abort_session( pls, "Error removing fifo" );
01559         free( (void *) iodev->fileName );
01560         iodev->fileName = NULL;
01561         if ( rmdir( dirname ) == -1 )
01562             abort_session( pls, "Error removing temporary directory" );
01563         free( (void *) dirname );
01564     }
01565 
01566 // Create socket for data transfer to the plframe widget
01567 
01568     else
01569     {
01570         iodev->type     = 1;
01571         iodev->typeName = "socket";
01572         tcl_cmd( pls, "plclient_dp_init" );
01573         iodev->fileHandle = Tcl_GetVar( dev->interp, "data_sock", 0 );
01574 
01575         if ( Tcl_GetOpenFile( dev->interp, iodev->fileHandle,
01576                  0, 1, ( ClientData ) & iodev->file ) != TCL_OK )
01577         {
01578             fprintf( stderr, "Cannot get file info:\n\t %s\n",
01579                 Tcl_GetStringResult( dev->interp ) );
01580             abort_session( pls, "" );
01581         }
01582         iodev->fd = fileno( iodev->file );
01583     }
01584 
01585 // Create data buffer
01586 
01587     pls->pdfs = pdf_bopen( NULL, (size_t) bufmax );
01588 }
01589 
01590 //--------------------------------------------------------------------------
01591 // WaitForPage()
01592 //
01593 // Waits for a page advance.
01594 //--------------------------------------------------------------------------
01595 
01596 static void
01597 WaitForPage( PLStream *pls )
01598 {
01599     TkDev *dev = (TkDev *) pls->dev;
01600 
01601     dbug_enter( "WaitForPage" );
01602 
01603     while ( !dev->exit_eventloop )
01604     {
01605         Tk_DoOneEvent( 0 );
01606     }
01607     dev->exit_eventloop = 0;
01608 }
01609 
01610 //--------------------------------------------------------------------------
01611 // CheckForEvents()
01612 //
01613 // A front-end to HandleEvents(), which is only called if certain conditions
01614 // are satisfied:
01615 //
01616 // - only check for events and process them every dev->max_instr times this
01617 //   function is called (good for performance since performing an update is
01618 //   a nontrivial performance hit).
01619 //--------------------------------------------------------------------------
01620 
01621 static void
01622 CheckForEvents( PLStream *pls )
01623 {
01624     TkDev *dev = (TkDev *) pls->dev;
01625 
01626     if ( ++dev->instr % dev->max_instr == 0 )
01627     {
01628         dev->instr = 0;
01629         HandleEvents( pls );
01630     }
01631 }
01632 
01633 //--------------------------------------------------------------------------
01634 // HandleEvents()
01635 //
01636 // Just a front-end to the update command, for use when not actually waiting
01637 // for an event but only checking the event queue.
01638 //--------------------------------------------------------------------------
01639 
01640 static void
01641 HandleEvents( PLStream *pls )
01642 {
01643     TkDev *dev = (TkDev *) pls->dev;
01644 
01645     dbug_enter( "HandleEvents" );
01646 
01647     Tcl_VarEval( dev->interp, dev->updatecmd, (char **) NULL );
01648 }
01649 
01650 //--------------------------------------------------------------------------
01651 // flush_output()
01652 //
01653 // Sends graphics instructions to the {FIFO|socket} via a packet send.
01654 //
01655 // The packet i/o routines are modified versions of the ones from the
01656 // Tcl-DP package.  They have been altered to take a pointer to a PDFstrm
01657 // struct, and read-to or write-from pdfs->buffer.  The length of the
01658 // buffer is stored in pdfs->bp (the original Tcl-DP routine assumes the
01659 // message is character data and uses strlen).  Also, they can
01660 // send/receive from either a fifo or a socket.
01661 //--------------------------------------------------------------------------
01662 
01663 static void
01664 flush_output( PLStream *pls )
01665 {
01666     TkDev   *dev  = (TkDev *) pls->dev;
01667     PDFstrm *pdfs = (PDFstrm *) pls->pdfs;
01668 
01669     dbug_enter( "flush_output" );
01670 
01671     HandleEvents( pls );
01672 
01673 // Send packet -- plserver filehandler will be invoked automatically.
01674 
01675     if ( pdfs->bp > 0 )
01676     {
01677 #ifdef DEBUG_ENTER
01678         pldebug( "flush_output", "%s: Flushing buffer, bytes = %ld\n",
01679             __FILE__, pdfs->bp );
01680 #endif
01681         if ( pl_PacketSend( dev->interp, dev->iodev, pls->pdfs ) )
01682         {
01683             fprintf( stderr, "Packet send failed:\n\t %s\n",
01684                 Tcl_GetStringResult( dev->interp ) );
01685             abort_session( pls, "" );
01686         }
01687         pdfs->bp = 0;
01688     }
01689 }
01690 
01691 //--------------------------------------------------------------------------
01692 // Abort
01693 //
01694 // Just a TCL front-end to abort_session().
01695 //--------------------------------------------------------------------------
01696 
01697 static int
01698 Abort( ClientData clientData, Tcl_Interp *PL_UNUSED( interp ), int PL_UNUSED( argc ), char **PL_UNUSED( argv ) )
01699 {
01700     PLStream *pls = (PLStream *) clientData;
01701 
01702     dbug_enter( "Abort" );
01703 
01704     abort_session( pls, "" );
01705     return TCL_OK;
01706 }
01707 
01708 //--------------------------------------------------------------------------
01709 // Plfinfo
01710 //
01711 // Sends info about the server plframe.  Usually issued after some
01712 // modification to the plframe is made by the user, such as a resize.
01713 //--------------------------------------------------------------------------
01714 
01715 static int
01716 Plfinfo( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
01717 {
01718     PLStream *pls   = (PLStream *) clientData;
01719     TkDev    *dev   = (TkDev *) pls->dev;
01720     int      result = TCL_OK;
01721 
01722     dbug_enter( "Plfinfo" );
01723 
01724     if ( argc < 3 )
01725     {
01726         Tcl_AppendResult( interp, "wrong # args: should be \"",
01727             " plfinfo wx wy\"", (char *) NULL );
01728         result = TCL_ERROR;
01729     }
01730     else
01731     {
01732         dev->width  = (unsigned int) atoi( argv[1] );
01733         dev->height = (unsigned int) atoi( argv[2] );
01734 #if PHYSICAL
01735         {
01736             PLFLT pxlx = (double) PIXELS_X / dev->width * DPMM;
01737             PLFLT pxly = (double) PIXELS_Y / dev->height * DPMM;
01738             plP_setpxl( pxlx, pxly );
01739         }
01740 #endif
01741     }
01742 
01743     return result;
01744 }
01745 
01746 //--------------------------------------------------------------------------
01747 // KeyEH()
01748 //
01749 // This TCL command handles keyboard events.
01750 //--------------------------------------------------------------------------
01751 
01752 static int
01753 KeyEH( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
01754 {
01755     PLStream *pls = (PLStream *) clientData;
01756     TkDev    *dev = (TkDev *) pls->dev;
01757     int      result;
01758 
01759     dbug_enter( "KeyEH" );
01760 
01761     if ( ( result = LookupTkKeyEvent( pls, interp, argc, argv ) ) != TCL_OK )
01762         return result;
01763 
01764     if ( dev->locate_mode )
01765         LocateKey( pls );
01766     else
01767         ProcessKey( pls );
01768 
01769     return result;
01770 }
01771 
01772 //--------------------------------------------------------------------------
01773 // ButtonEH()
01774 //
01775 // This TCL command handles button events.
01776 //--------------------------------------------------------------------------
01777 
01778 static int
01779 ButtonEH( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
01780 {
01781     PLStream *pls = (PLStream *) clientData;
01782     TkDev    *dev = (TkDev *) pls->dev;
01783     int      result;
01784 
01785     dbug_enter( "ButtonEH" );
01786 
01787     if ( ( result = LookupTkButtonEvent( pls, interp, argc, argv ) ) != TCL_OK )
01788         return result;
01789 
01790     if ( dev->locate_mode )
01791         LocateButton( pls );
01792     else
01793         ProcessButton( pls );
01794 
01795     return result;
01796 }
01797 
01798 //--------------------------------------------------------------------------
01799 // LookupTkKeyEvent()
01800 //
01801 // Fills in the PLGraphicsIn from a Tk KeyEvent.
01802 //
01803 // Contents of argv array:
01804 //      command name
01805 //      keysym value
01806 //      keysym state
01807 //      absolute x coordinate of cursor
01808 //      absolute y coordinate of cursor
01809 //      relative x coordinate (normalized to [0.0 1.0])
01810 //      relative y coordinate (normalized to [0.0 1.0])
01811 //      keysym name
01812 //      ASCII equivalent (optional)
01813 //
01814 // Note that the keysym name is only used for debugging, and the string is
01815 // not always passed (i.e. the character may not have an ASCII
01816 // representation).
01817 //--------------------------------------------------------------------------
01818 
01819 static int
01820 LookupTkKeyEvent( PLStream *pls, Tcl_Interp *interp, int argc, char **argv )
01821 {
01822     TkDev        *dev = (TkDev *) pls->dev;
01823     PLGraphicsIn *gin = &( dev->gin );
01824     char         *keyname;
01825 
01826     dbug_enter( "LookupTkKeyEvent" );
01827 
01828     if ( argc < 8 )
01829     {
01830         Tcl_AppendResult( interp, "wrong # args: should be \"",
01831             argv[0], " key-value state pX pY dX dY key-name ?ascii-value?\"",
01832             (char *) NULL );
01833         return TCL_ERROR;
01834     }
01835 
01836     gin->keysym = (unsigned int) atol( argv[1] );
01837     gin->state  = (unsigned int) atol( argv[2] );
01838     gin->pX     = atoi( argv[3] );
01839     gin->pY     = atoi( argv[4] );
01840     gin->dX     = atof( argv[5] );
01841     gin->dY     = atof( argv[6] );
01842 
01843     keyname = argv[7];
01844 
01845     gin->string[0] = '\0';
01846     if ( argc > 8 )
01847     {
01848         gin->string[0] = argv[8][0];
01849         gin->string[1] = '\0';
01850     }
01851 
01852 // Fix up keysym value -- see notes in xwin.c about key representation
01853 
01854     switch ( gin->keysym )
01855     {
01856     case XK_BackSpace:
01857     case XK_Tab:
01858     case XK_Linefeed:
01859     case XK_Return:
01860     case XK_Escape:
01861     case XK_Delete:
01862         gin->keysym &= 0xFF;
01863         break;
01864     }
01865 
01866     pldebug( "LookupTkKeyEvent",
01867         "KeyEH: stream: %d, Keyname %s, hex %x, ASCII: %s\n",
01868         (int) pls->ipls, keyname, (unsigned int) gin->keysym, gin->string );
01869 
01870     return TCL_OK;
01871 }
01872 
01873 //--------------------------------------------------------------------------
01874 // LookupTkButtonEvent()
01875 //
01876 // Fills in the PLGraphicsIn from a Tk ButtonEvent.
01877 //
01878 // Contents of argv array:
01879 //      command name
01880 //      button number
01881 //      state (decimal string)
01882 //      absolute x coordinate
01883 //      absolute y coordinate
01884 //      relative x coordinate (normalized to [0.0 1.0])
01885 //      relative y coordinate (normalized to [0.0 1.0])
01886 //--------------------------------------------------------------------------
01887 
01888 static int
01889 LookupTkButtonEvent( PLStream *pls, Tcl_Interp *interp, int argc, char **argv )
01890 {
01891     TkDev        *dev = (TkDev *) pls->dev;
01892     PLGraphicsIn *gin = &( dev->gin );
01893 
01894     dbug_enter( "LookupTkButtonEvent" );
01895 
01896     if ( argc != 7 )
01897     {
01898         Tcl_AppendResult( interp, "wrong # args: should be \"",
01899             argv[0], " button-number state pX pY dX dY\"", (char *) NULL );
01900         return TCL_ERROR;
01901     }
01902 
01903     gin->button = (unsigned int) atol( argv[1] );
01904     gin->state  = (unsigned int) atol( argv[2] );
01905     gin->pX     = atoi( argv[3] );
01906     gin->pY     = atoi( argv[4] );
01907     gin->dX     = atof( argv[5] );
01908     gin->dY     = atof( argv[6] );
01909     gin->keysym = 0x20;
01910 
01911     pldebug( "LookupTkButtonEvent",
01912         "button %d, state %d, pX: %d, pY: %d, dX: %f, dY: %f\n",
01913         gin->button, gin->state, gin->pX, gin->pY, gin->dX, gin->dY );
01914 
01915     return TCL_OK;
01916 }
01917 
01918 //--------------------------------------------------------------------------
01919 // ProcessKey()
01920 //
01921 // Process keyboard events other than locate input.
01922 //--------------------------------------------------------------------------
01923 
01924 static void
01925 ProcessKey( PLStream *pls )
01926 {
01927     TkDev        *dev = (TkDev *) pls->dev;
01928     PLGraphicsIn *gin = &( dev->gin );
01929 
01930     dbug_enter( "ProcessKey" );
01931 
01932 // Call user keypress event handler.  Since this is called first, the user
01933 // can disable all internal event handling by setting key.keysym to 0.
01934 //
01935     if ( pls->KeyEH != NULL )
01936         ( *pls->KeyEH )( gin, pls->KeyEH_data, &dev->exit_eventloop );
01937 
01938 // Handle internal events
01939 
01940     switch ( gin->keysym )
01941     {
01942     case PLK_Return:
01943     case PLK_Linefeed:
01944     case PLK_Next:
01945         // Advance to next page (i.e. terminate event loop) on a <eol>
01946         // Check for both <CR> and <LF> for portability, also a <Page Down>
01947         dev->exit_eventloop = TRUE;
01948         break;
01949 
01950     case 'Q':
01951         // Terminate on a 'Q' (not 'q', since it's too easy to hit by mistake)
01952         tcl_cmd( pls, "abort" );
01953         break;
01954 
01955     case 'L':
01956         // Begin locate mode
01957         dev->locate_mode = LOCATE_INVOKED_VIA_DRIVER;
01958         server_cmd( pls, "$plwidget configure -xhairs on", 1 );
01959         break;
01960     }
01961 }
01962 
01963 //--------------------------------------------------------------------------
01964 // ProcessButton()
01965 //
01966 // Process ButtonPress events other than locate input.
01967 // On:
01968 //   Button1: nothing (except when in locate mode, see ButtonLocate)
01969 //   Button2: nothing
01970 //   Button3: set page advance flag
01971 //--------------------------------------------------------------------------
01972 
01973 static void
01974 ProcessButton( PLStream *pls )
01975 {
01976     TkDev        *dev = (TkDev *) pls->dev;
01977     PLGraphicsIn *gin = &( dev->gin );
01978 
01979     dbug_enter( "ButtonEH" );
01980 
01981 // Call user event handler.  Since this is called first, the user can
01982 // disable all PLplot internal event handling by setting gin->button to 0.
01983 //
01984     if ( pls->ButtonEH != NULL )
01985         ( *pls->ButtonEH )( gin, pls->ButtonEH_data, &dev->exit_eventloop );
01986 
01987 // Handle internal events
01988 
01989     switch ( gin->button )
01990     {
01991     case Button3:
01992         dev->exit_eventloop = TRUE;
01993         break;
01994     }
01995 }
01996 
01997 //--------------------------------------------------------------------------
01998 // LocateKey()
01999 //
02000 // Front-end to locate handler for KeyPress events.
02001 // Only provides for:
02002 //
02003 //  <Escape>            Ends locate mode
02004 //--------------------------------------------------------------------------
02005 
02006 static void
02007 LocateKey( PLStream *pls )
02008 {
02009     TkDev        *dev = (TkDev *) pls->dev;
02010     PLGraphicsIn *gin = &( dev->gin );
02011 
02012 // End locate mode on <Escape>
02013 
02014     if ( gin->keysym == PLK_Escape )
02015     {
02016         dev->locate_mode = 0;
02017         server_cmd( pls, "$plwidget configure -xhairs off", 1 );
02018         plGinInit( gin );
02019     }
02020     else
02021     {
02022         Locate( pls );
02023     }
02024 }
02025 
02026 //--------------------------------------------------------------------------
02027 // LocateButton()
02028 //
02029 // Front-end to locate handler for ButtonPress events.
02030 // Only passes control to Locate() for Button1 presses.
02031 //--------------------------------------------------------------------------
02032 
02033 static void
02034 LocateButton( PLStream *pls )
02035 {
02036     TkDev        *dev = (TkDev *) pls->dev;
02037     PLGraphicsIn *gin = &( dev->gin );
02038 
02039     switch ( gin->button )
02040     {
02041     case Button1:
02042         Locate( pls );
02043         break;
02044     }
02045 }
02046 
02047 //--------------------------------------------------------------------------
02048 // Locate()
02049 //
02050 // Handles locate mode events.
02051 //
02052 // In locate mode: move cursor to desired location and select by pressing a
02053 // key or by clicking on the mouse (if available).  Typically the world
02054 // coordinates of the selected point are reported.
02055 //
02056 // There are two ways to enter Locate mode -- via the API, or via a driver
02057 // command.  The API entry point is the call plGetCursor(), which initiates
02058 // locate mode and does not return until input has been obtained.  The
02059 // driver entry point is by entering a 'L' while the driver is waiting for
02060 // events.
02061 //
02062 // Locate mode input is reported in one of three ways:
02063 // 1. Through a returned PLGraphicsIn structure, when user has specified a
02064 //    locate handler via (*pls->LocateEH).
02065 // 2. Through a returned PLGraphicsIn structure, when locate mode is invoked
02066 //    by a plGetCursor() call.
02067 // 3. Through writes to stdout, when locate mode is invoked by a driver
02068 //    command and the user has not supplied a locate handler.
02069 //
02070 // Hitting <Escape> will at all times end locate mode.  Other keys will
02071 // typically be interpreted as locator input.  Selecting a point out of
02072 // bounds will end locate mode unless the user overrides with a supplied
02073 // Locate handler.
02074 //--------------------------------------------------------------------------
02075 
02076 static void
02077 Locate( PLStream *pls )
02078 {
02079     TkDev        *dev = (TkDev *) pls->dev;
02080     PLGraphicsIn *gin = &( dev->gin );
02081 
02082 // Call user locate mode handler if provided
02083 
02084     if ( pls->LocateEH != NULL )
02085         ( *pls->LocateEH )( gin, pls->LocateEH_data, &dev->locate_mode );
02086 
02087 // Use default procedure
02088 
02089     else
02090     {
02091         // Try to locate cursor
02092 
02093         if ( plTranslateCursor( gin ) )
02094         {
02095             // If invoked by the API, we're done
02096             // Otherwise send report to stdout
02097 
02098             if ( dev->locate_mode == LOCATE_INVOKED_VIA_DRIVER )
02099             {
02100                 pltext();
02101                 if ( gin->keysym < 0xFF && isprint( gin->keysym ) )
02102                     printf( "%f %f %c\n", gin->wX, gin->wY, gin->keysym );
02103                 else
02104                     printf( "%f %f 0x%02x\n", gin->wX, gin->wY, gin->keysym );
02105 
02106                 plgra();
02107             }
02108         }
02109         else
02110         {
02111             // Selected point is out of bounds, so end locate mode
02112 
02113             dev->locate_mode = 0;
02114             server_cmd( pls, "$plwidget configure -xhairs off", 1 );
02115         }
02116     }
02117 }
02118 
02119 //--------------------------------------------------------------------------
02120 //
02121 // pltk_toplevel --
02122 //
02123 //      Create top level window without mapping it.
02124 //
02125 // Results:
02126 //      Returns 1 on error.
02127 //
02128 // Side effects:
02129 //      Returns window ID as *w.
02130 //
02131 //--------------------------------------------------------------------------
02132 
02133 static int
02134 pltk_toplevel( Tk_Window *PL_UNUSED( w ), Tcl_Interp *interp )
02135 {
02136     static char wcmd[] = "wm withdraw .";
02137 
02138 // Create the main window without mapping it
02139 
02140     if ( Tk_Init( interp ) )
02141     {
02142         fprintf( stderr, "tk_init:%s\n", Tcl_GetStringResult( interp ) );
02143         return 1;
02144     }
02145 
02146     Tcl_VarEval( interp, wcmd, (char *) NULL );
02147 
02148     return 0;
02149 }
02150 
02151 //--------------------------------------------------------------------------
02152 // tk_wait()
02153 //
02154 // Waits for the specified expression to evaluate to true before
02155 // proceeding.  While we are waiting to proceed, all events (for this
02156 // or other interpreters) are handled.
02157 //
02158 // Use a static string buffer to hold the command, to ensure it's in
02159 // writable memory (grrr...).
02160 //--------------------------------------------------------------------------
02161 
02162 static void
02163 tk_wait( PLStream *pls, const char *cmd )
02164 {
02165     TkDev *dev   = (TkDev *) pls->dev;
02166     int   result = 0;
02167 
02168     dbug_enter( "tk_wait" );
02169 
02170     copybuf( pls, cmd );
02171     for (;; )
02172     {
02173         if ( Tcl_ExprBoolean( dev->interp, dev->cmdbuf, &result ) )
02174         {
02175             fprintf( stderr, "tk_wait command \"%s\" failed:\n\t %s\n",
02176                 cmd, Tcl_GetStringResult( dev->interp ) );
02177             break;
02178         }
02179         if ( result )
02180             break;
02181 
02182         Tk_DoOneEvent( 0 );
02183     }
02184 }
02185 
02186 //--------------------------------------------------------------------------
02187 // server_cmd
02188 //
02189 // Sends specified command to server, aborting on an error.
02190 // If nowait is set, the command is issued in the background.
02191 //
02192 // If commands MUST proceed in a certain order (e.g. initialization), it
02193 // is safest to NOT run them in the background.
02194 //
02195 // In order to protect args that have embedded spaces in them, I enclose
02196 // the entire command in a [list ...], but for TK sends ONLY.  If done with
02197 // Tcl-DP RPC, the sent command is no longer recognized.  Evidently an
02198 // extra scan of the line is done with TK sends for some reason.
02199 //--------------------------------------------------------------------------
02200 
02201 static void
02202 server_cmd( PLStream *pls, const char *cmd, int nowait )
02203 {
02204     TkDev       *dev          = (TkDev *) pls->dev;
02205     static char dpsend_cmd0[] = "dp_RPC $server ";
02206     static char dpsend_cmd1[] = "dp_RDO $server ";
02207     static char tksend_cmd0[] = "send $server ";
02208     static char tksend_cmd1[] = "send $server after 1 ";
02209     int         result;
02210 
02211     dbug_enter( "server_cmd" );
02212     pldebug( "server_cmd", "Sending command: %s\n", cmd );
02213 
02214     if ( pls->dp )
02215     {
02216         if ( nowait )
02217             result = Tcl_VarEval( dev->interp, dpsend_cmd1, cmd,
02218                 (char **) NULL );
02219         else
02220             result = Tcl_VarEval( dev->interp, dpsend_cmd0, cmd,
02221                 (char **) NULL );
02222     }
02223     else
02224     {
02225         if ( nowait )
02226             result = Tcl_VarEval( dev->interp, tksend_cmd1, "[list ",
02227                 cmd, "]", (char **) NULL );
02228         else
02229             result = Tcl_VarEval( dev->interp, tksend_cmd0, "[list ",
02230                 cmd, "]", (char **) NULL );
02231     }
02232 
02233     if ( result != TCL_OK )
02234     {
02235         fprintf( stderr, "Server command \"%s\" failed:\n\t %s\n",
02236             cmd, Tcl_GetStringResult( dev->interp ) );
02237         abort_session( pls, "" );
02238     }
02239 }
02240 
02241 //--------------------------------------------------------------------------
02242 // tcl_cmd
02243 //
02244 // Evals the specified command, aborting on an error.
02245 //--------------------------------------------------------------------------
02246 
02247 static void
02248 tcl_cmd( PLStream *pls, const char *cmd )
02249 {
02250     TkDev *dev = (TkDev *) pls->dev;
02251 
02252     dbug_enter( "tcl_cmd" );
02253 
02254     pldebug( "tcl_cmd", "Evaluating command: %s\n", cmd );
02255     if ( Tcl_VarEval( dev->interp, cmd, (char **) NULL ) != TCL_OK )
02256     {
02257         fprintf( stderr, "TCL command \"%s\" failed:\n\t %s\n",
02258             cmd, Tcl_GetStringResult( dev->interp ) );
02259         abort_session( pls, "" );
02260     }
02261 }
02262 
02263 //--------------------------------------------------------------------------
02264 // copybuf
02265 //
02266 // Puts command in a static string buffer, to ensure it's in writable
02267 // memory (grrr...).
02268 //--------------------------------------------------------------------------
02269 
02270 static void
02271 copybuf( PLStream *pls, const char *cmd )
02272 {
02273     TkDev *dev = (TkDev *) pls->dev;
02274 
02275     if ( dev->cmdbuf == NULL )
02276     {
02277         dev->cmdbuf_len = 100;
02278         dev->cmdbuf     = (char *) malloc( dev->cmdbuf_len );
02279     }
02280 
02281     if ( strlen( cmd ) >= dev->cmdbuf_len )
02282     {
02283         free( (void *) dev->cmdbuf );
02284         dev->cmdbuf_len = strlen( cmd ) + 20;
02285         dev->cmdbuf     = (char *) malloc( dev->cmdbuf_len );
02286     }
02287 
02288     strcpy( dev->cmdbuf, cmd );
02289 }
02290 
02291 //--------------------------------------------------------------------------
02292 #else
02293 int
02294 pldummy_tk()
02295 {
02296     return 0;
02297 }
02298 
02299 #endif                          // PLD_tk
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Defines