• Main Page
  • Namespaces
  • Classes
  • Files
  • File List
  • File Members

tk.c

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

Generated on Wed Oct 12 2011 20:42:23 for PLplot by  doxygen 1.7.1