PLplot
5.10.0
|
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