1 // PLplot Tcl/Tk and Tcl-DP device drivers. 2 // Should be broken up somewhat better to allow use of DP w/o X. 3 // 4 // Maurice LeBrun 5 // 30-Apr-93 6 // 7 // Copyright (C) 2004 Maurice LeBrun 8 // Copyright (C) 2004 Joao Cardoso 9 // Copyright (C) 2004 Andrew Ross 10 // 11 // This file is part of PLplot. 12 // 13 // PLplot is free software; you can redistribute it and/or modify 14 // it under the terms of the GNU Library General Public License as published 15 // by the Free Software Foundation; either version 2 of the License, or 16 // (at your option) any later version. 17 // 18 // PLplot is distributed in the hope that it will be useful, 19 // but WITHOUT ANY WARRANTY; without even the implied warranty of 20 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 // GNU Library General Public License for more details. 22 // 23 // You should have received a copy of the GNU Library General Public License 24 // along with PLplot; if not, write to the Free Software 25 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 26 // 27 28 // 29 // #define DEBUG_ENTER 30 // 31 32 #define DEBUG 33 34 #include "plDevs.h" 35 36 #ifdef PLD_tk 37 38 #define NEED_PLDEBUG 39 #include "pltkd.h" 40 #include "pltcl.h" 41 #include "tcpip.h" 42 #include "drivers.h" 43 #include "metadefs.h" 44 #include "plevent.h" 45 #include <X11/keysym.h> 46 47 #if PL_HAVE_UNISTD_H 48 # include <unistd.h> 49 #endif 50 #include <sys/types.h> 51 #if HAVE_SYS_WAIT_H 52 # include <sys/wait.h> 53 #endif 54 #include <sys/stat.h> 55 #include <fcntl.h> 56 #include <errno.h> 57 #include <signal.h> 58 59 #ifdef PLD_dp 60 # include <dp.h> 61 #endif 62 63 // Device info 64 PLDLLIMPEXP_DRIVER const char* plD_DEVICE_INFO_tk = "tk:Tcl/TK Window:1:tk:7:tk\n"; 65 66 67 // Number of instructions to skip between updates 68 69 #define MAX_INSTR 100 70 71 // Pixels/mm 72 73 #define PHYSICAL 0 // Enables physical scaling.. 74 75 // These need to be distinguished since the handling is slightly different. 76 77 #define LOCATE_INVOKED_VIA_API 1 78 #define LOCATE_INVOKED_VIA_DRIVER 2 79 80 #define STR_LEN 10 81 #define CMD_LEN 100 82 83 // A handy command wrapper 84 85 #define tk_wr( code ) \ 86 if ( code ) { abort_session( pls, "Unable to write to PDFstrm" ); } 87 88 //-------------------------------------------------------------------------- 89 // Function prototypes 90 91 // Driver entry and dispatch setup 92 93 void plD_dispatch_init_tk( PLDispatchTable *pdt ); 94 95 void plD_init_tk( PLStream * ); 96 void plD_line_tk( PLStream *, short, short, short, short ); 97 void plD_polyline_tk( PLStream *, short *, short *, PLINT ); 98 void plD_eop_tk( PLStream * ); 99 void plD_bop_tk( PLStream * ); 100 void plD_tidy_tk( PLStream * ); 101 void plD_state_tk( PLStream *, PLINT ); 102 void plD_esc_tk( PLStream *, PLINT, void * ); 103 void plD_init_dp( PLStream *pls ); 104 105 // various 106 107 static void init( PLStream *pls ); 108 static void tk_start( PLStream *pls ); 109 static void tk_stop( PLStream *pls ); 110 static void tk_di( PLStream *pls ); 111 static void tk_fill( PLStream *pls ); 112 static void WaitForPage( PLStream *pls ); 113 static void CheckForEvents( PLStream *pls ); 114 static void HandleEvents( PLStream *pls ); 115 static void init_server( PLStream *pls ); 116 static void launch_server( PLStream *pls ); 117 static void flush_output( PLStream *pls ); 118 static void plwindow_init( PLStream *pls ); 119 static void link_init( PLStream *pls ); 120 static void GetCursor( PLStream *pls, PLGraphicsIn *ptr ); 121 static void tk_XorMod( PLStream *pls, PLINT *ptr ); 122 static void set_windowname( PLStream *pls ); 123 124 // performs Tk-driver-specific initialization 125 126 static int pltkdriver_Init( PLStream *pls ); 127 128 // Tcl/TK utility commands 129 130 static void tk_wait( PLStream *pls, const char * ); 131 static void abort_session( PLStream *pls, const char * ); 132 static void server_cmd( PLStream *pls, const char *, int ); 133 static void tcl_cmd( PLStream *pls, const char * ); 134 static void copybuf( PLStream *pls, const char *cmd ); 135 static int pltk_toplevel( Tk_Window *w, Tcl_Interp *interp ); 136 137 static void ProcessKey( PLStream *pls ); 138 static void ProcessButton( PLStream *pls ); 139 static void LocateKey( PLStream *pls ); 140 static void LocateButton( PLStream *pls ); 141 static void Locate( PLStream *pls ); 142 143 // These are internal TCL commands 144 145 static int Abort( ClientData, Tcl_Interp *, int, char ** ); 146 static int Plfinfo( ClientData, Tcl_Interp *, int, char ** ); 147 static int KeyEH( ClientData, Tcl_Interp *, int, char ** ); 148 static int ButtonEH( ClientData, Tcl_Interp *, int, char ** ); 149 static int LookupTkKeyEvent( PLStream *pls, Tcl_Interp *interp, 150 int argc, char **argv ); 151 static int LookupTkButtonEvent( PLStream *pls, Tcl_Interp *interp, 152 int argc, char **argv ); 153 154 static char *drvoptcmd = NULL; // tcl command from command line option parsing 155 156 static DrvOpt tk_options[] = { { "tcl_cmd", DRV_STR, &drvoptcmd, "Execute tcl command" }, 157 { NULL, DRV_INT, NULL, NULL } }; 158 159 void plD_dispatch_init_tk( PLDispatchTable *pdt ) 160 { 161 #ifndef ENABLE_DYNDRIVERS 162 pdt->pl_MenuStr = "Tcl/TK Window"; 163 pdt->pl_DevName = "tk"; 164 #endif 165 pdt->pl_type = plDevType_Interactive; 166 pdt->pl_seq = 7; 167 pdt->pl_init = (plD_init_fp) plD_init_tk; 168 pdt->pl_line = (plD_line_fp) plD_line_tk; 169 pdt->pl_polyline = (plD_polyline_fp) plD_polyline_tk; 170 pdt->pl_eop = (plD_eop_fp) plD_eop_tk; 171 pdt->pl_bop = (plD_bop_fp) plD_bop_tk; 172 pdt->pl_tidy = (plD_tidy_fp) plD_tidy_tk; 173 pdt->pl_state = (plD_state_fp) plD_state_tk; 174 pdt->pl_esc = (plD_esc_fp) plD_esc_tk; 175 } 176 177 //-------------------------------------------------------------------------- 178 // plD_init_dp() 179 // plD_init_tk() 180 // init_tk() 181 // 182 // Initialize device. 183 // TK-dependent stuff done in tk_start(). You can set the display by 184 // calling plsfnam() with the display name as the (string) argument. 185 //-------------------------------------------------------------------------- 186 187 void 188 plD_init_tk( PLStream *pls ) 189 { 190 pls->dp = 0; 191 plParseDrvOpts( tk_options ); 192 init( pls ); 193 } 194 195 void 196 plD_init_dp( PLStream *pls ) 197 { 198 #ifdef PLD_dp 199 pls->dp = 1; 200 #else 201 fprintf( stderr, "The Tcl-DP driver hasn't been installed!\n" ); 202 pls->dp = 0; 203 #endif 204 init( pls ); 205 } 206 207 static void 208 tk_wr_header( PLStream *pls, const char *header ) 209 { 210 tk_wr( pdf_wr_header( pls->pdfs, header ) ); 211 } 212 213 static void 214 init( PLStream *pls ) 215 { 216 U_CHAR c = (U_CHAR) INITIALIZE; 217 TkDev *dev; 218 PLFLT pxlx, pxly; 219 int xmin = 0; 220 int xmax = PIXELS_X - 1; 221 int ymin = 0; 222 int ymax = PIXELS_Y - 1; 223 224 dbug_enter( "plD_init_tk" ); 225 226 pls->color = 1; // Is a color device 227 pls->termin = 1; // Is an interactive terminal 228 pls->dev_di = 1; // Handle driver interface commands 229 pls->dev_flush = 1; // Handle our own flushes 230 pls->dev_fill0 = 1; // Handle solid fills 231 pls->dev_fill1 = 1; // Driver handles pattern fills 232 pls->server_nokill = 1; // don't kill if ^C 233 pls->dev_xor = 1; // device support xor mode 234 235 // Activate plot buffer. To programmatically save a file we can't call 236 // plreplot(), but instead one must send a command to plserver. As there is 237 // no API call for this, the user must use the plserver "save/print" menu 238 // entries. Activating the plot buffer enables the normal 239 // plmkstrm/plcpstrm/plreplot/plend1 way of saving plots. 240 // 241 pls->plbuf_write = 1; 242 243 // Specify buffer size if not yet set (can be changed by -bufmax option). 244 // A small buffer works best for socket communication 245 246 if ( pls->bufmax == 0 ) 247 { 248 if ( pls->dp ) 249 pls->bufmax = 450; 250 else 251 pls->bufmax = 3500; 252 } 253 254 // Allocate and initialize device-specific data 255 256 if ( pls->dev != NULL ) 257 free( (void *) pls->dev ); 258 259 pls->dev = calloc( 1, (size_t) sizeof ( TkDev ) ); 260 if ( pls->dev == NULL ) 261 plexit( "plD_init_tk: Out of memory." ); 262 263 dev = (TkDev *) pls->dev; 264 265 dev->iodev = (PLiodev *) calloc( 1, (size_t) sizeof ( PLiodev ) ); 266 if ( dev->iodev == NULL ) 267 plexit( "plD_init_tk: Out of memory." ); 268 269 dev->exit_eventloop = FALSE; 270 271 // Variables used in querying plserver for events 272 273 dev->instr = 0; 274 dev->max_instr = MAX_INSTR; 275 276 // Start interpreter and spawn server process 277 278 tk_start( pls ); 279 280 // Get ready for plotting 281 282 dev->xold = PL_UNDEFINED; 283 dev->yold = PL_UNDEFINED; 284 285 #if PHYSICAL 286 pxlx = (double) PIXELS_X / dev->width * DPMM; 287 pxly = (double) PIXELS_Y / dev->height * DPMM; 288 #else 289 pxlx = (double) PIXELS_X / LPAGE_X; 290 pxly = (double) PIXELS_Y / LPAGE_Y; 291 #endif 292 293 plP_setpxl( pxlx, pxly ); 294 plP_setphy( xmin, xmax, ymin, ymax ); 295 296 // Send init info 297 298 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 299 300 // The header and version fields are useful when the client & server 301 // reside on different machines 302 303 tk_wr_header( pls, PLSERV_HEADER ); 304 tk_wr_header( pls, PLSERV_VERSION ); 305 306 tk_wr_header( pls, "xmin" ); 307 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) xmin ) ); 308 309 tk_wr_header( pls, "xmax" ); 310 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) xmax ) ); 311 312 tk_wr_header( pls, "ymin" ); 313 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) ymin ) ); 314 315 tk_wr_header( pls, "ymax" ); 316 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) ymax ) ); 317 318 tk_wr_header( pls, "" ); 319 320 // Write color map state info 321 plD_state_tk( pls, PLSTATE_CMAP0 ); 322 plD_state_tk( pls, PLSTATE_CMAP1 ); 323 324 // Good place to make sure the data transfer is working OK 325 326 flush_output( pls ); 327 } 328 329 //-------------------------------------------------------------------------- 330 // plD_line_tk() 331 // 332 // Draw a line in the current color from (x1,y1) to (x2,y2). 333 //-------------------------------------------------------------------------- 334 335 void 336 plD_line_tk( PLStream *pls, short x1, short y1, short x2, short y2 ) 337 { 338 U_CHAR c; 339 U_SHORT xy[4]; 340 TkDev *dev = (TkDev *) pls->dev; 341 342 CheckForEvents( pls ); 343 344 if ( x1 == dev->xold && y1 == dev->yold ) 345 { 346 c = (U_CHAR) LINETO; 347 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 348 349 xy[0] = (U_SHORT) x2; 350 xy[1] = (U_SHORT) y2; 351 tk_wr( pdf_wr_2nbytes( pls->pdfs, xy, 2 ) ); 352 } 353 else 354 { 355 c = (U_CHAR) LINE; 356 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 357 358 xy[0] = (U_SHORT) x1; 359 xy[1] = (U_SHORT) y1; 360 xy[2] = (U_SHORT) x2; 361 xy[3] = (U_SHORT) y2; 362 tk_wr( pdf_wr_2nbytes( pls->pdfs, xy, 4 ) ); 363 } 364 dev->xold = x2; 365 dev->yold = y2; 366 367 if ( pls->pdfs->bp > (size_t) pls->bufmax ) 368 flush_output( pls ); 369 } 370 371 //-------------------------------------------------------------------------- 372 // plD_polyline_tk() 373 // 374 // Draw a polyline in the current color from (x1,y1) to (x2,y2). 375 //-------------------------------------------------------------------------- 376 377 void 378 plD_polyline_tk( PLStream *pls, short *xa, short *ya, PLINT npts ) 379 { 380 U_CHAR c = (U_CHAR) POLYLINE; 381 TkDev *dev = (TkDev *) pls->dev; 382 383 CheckForEvents( pls ); 384 385 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 386 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) npts ) ); 387 388 tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) xa, npts ) ); 389 tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) ya, npts ) ); 390 391 dev->xold = xa[npts - 1]; 392 dev->yold = ya[npts - 1]; 393 394 if ( pls->pdfs->bp > (size_t) pls->bufmax ) 395 flush_output( pls ); 396 } 397 398 //-------------------------------------------------------------------------- 399 // plD_eop_tk() 400 // 401 // End of page. 402 // User must hit <RETURN> to continue. 403 //-------------------------------------------------------------------------- 404 405 void 406 plD_eop_tk( PLStream *pls ) 407 { 408 U_CHAR c = (U_CHAR) EOP; 409 410 dbug_enter( "plD_eop_tk" ); 411 412 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 413 flush_output( pls ); 414 if ( !pls->nopause ) 415 WaitForPage( pls ); 416 } 417 418 //-------------------------------------------------------------------------- 419 // plD_bop_tk() 420 // 421 // Set up for the next page. 422 //-------------------------------------------------------------------------- 423 424 void 425 plD_bop_tk( PLStream *pls ) 426 { 427 U_CHAR c = (U_CHAR) BOP; 428 TkDev *dev = (TkDev *) pls->dev; 429 430 dbug_enter( "plD_bop_tk" ); 431 432 dev->xold = PL_UNDEFINED; 433 dev->yold = PL_UNDEFINED; 434 pls->page++; 435 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 436 } 437 438 //-------------------------------------------------------------------------- 439 // plD_tidy_tk() 440 // 441 // Close graphics file 442 //-------------------------------------------------------------------------- 443 444 void 445 plD_tidy_tk( PLStream *pls ) 446 { 447 TkDev *dev = (TkDev *) pls->dev; 448 449 dbug_enter( "plD_tidy_tk" ); 450 451 if ( dev != NULL ) 452 tk_stop( pls ); 453 } 454 455 //-------------------------------------------------------------------------- 456 // plD_state_tk() 457 // 458 // Handle change in PLStream state (color, pen width, fill attribute, etc). 459 //-------------------------------------------------------------------------- 460 461 void 462 plD_state_tk( PLStream *pls, PLINT op ) 463 { 464 U_CHAR c = (U_CHAR) CHANGE_STATE; 465 int i; 466 467 dbug_enter( "plD_state_tk" ); 468 469 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 470 tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) ); 471 472 switch ( op ) 473 { 474 case PLSTATE_WIDTH: 475 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) ( pls->width ) ) ); 476 break; 477 478 case PLSTATE_COLOR0: 479 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->icol0 ) ); 480 481 if ( pls->icol0 == PL_RGB_COLOR ) 482 { 483 tk_wr( pdf_wr_1byte( pls->pdfs, pls->curcolor.r ) ); 484 tk_wr( pdf_wr_1byte( pls->pdfs, pls->curcolor.g ) ); 485 tk_wr( pdf_wr_1byte( pls->pdfs, pls->curcolor.b ) ); 486 } 487 break; 488 489 case PLSTATE_COLOR1: 490 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->icol1 ) ); 491 break; 492 493 case PLSTATE_FILL: 494 tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) pls->patt ) ); 495 break; 496 497 case PLSTATE_CMAP0: 498 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->ncol0 ) ); 499 for ( i = 0; i < pls->ncol0; i++ ) 500 { 501 tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap0[i].r ) ); 502 tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap0[i].g ) ); 503 tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap0[i].b ) ); 504 } 505 break; 506 507 case PLSTATE_CMAP1: 508 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->ncol1 ) ); 509 for ( i = 0; i < pls->ncol1; i++ ) 510 { 511 tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap1[i].r ) ); 512 tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap1[i].g ) ); 513 tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap1[i].b ) ); 514 } 515 // Need to send over the control points too! 516 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->ncp1 ) ); 517 for ( i = 0; i < pls->ncp1; i++ ) 518 { 519 tk_wr( pdf_wr_ieeef( pls->pdfs, (float) pls->cmap1cp[i].c1 ) ); 520 tk_wr( pdf_wr_ieeef( pls->pdfs, (float) pls->cmap1cp[i].c2 ) ); 521 tk_wr( pdf_wr_ieeef( pls->pdfs, (float) pls->cmap1cp[i].c3 ) ); 522 tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) pls->cmap1cp[i].alt_hue_path ) ); 523 } 524 break; 525 } 526 527 if ( pls->pdfs->bp > (size_t) pls->bufmax ) 528 flush_output( pls ); 529 } 530 531 //-------------------------------------------------------------------------- 532 // plD_esc_tk() 533 // 534 // Escape function. 535 // Functions: 536 // 537 // PLESC_EXPOSE Force an expose (just passes token) 538 // PLESC_RESIZE Force a resize (just passes token) 539 // PLESC_REDRAW Force a redraw 540 // PLESC_FLUSH Flush X event buffer 541 // PLESC_FILL Fill polygon 542 // PLESC_EH Handle events only 543 // PLESC_XORMOD Xor mode 544 // 545 //-------------------------------------------------------------------------- 546 547 void 548 plD_esc_tk( PLStream *pls, PLINT op, void *ptr ) 549 { 550 U_CHAR c = (U_CHAR) ESCAPE; 551 552 dbug_enter( "plD_esc_tk" ); 553 554 switch ( op ) 555 { 556 case PLESC_DI: 557 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 558 tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) ); 559 tk_di( pls ); 560 break; 561 562 case PLESC_EH: 563 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 564 tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) ); 565 HandleEvents( pls ); 566 break; 567 568 case PLESC_FLUSH: 569 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 570 tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) ); 571 flush_output( pls ); 572 break; 573 574 case PLESC_FILL: 575 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 576 tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) ); 577 tk_fill( pls ); 578 break; 579 580 case PLESC_GETC: 581 GetCursor( pls, (PLGraphicsIn *) ptr ); 582 break; 583 584 case PLESC_XORMOD: 585 tk_XorMod( pls, (PLINT *) ptr ); 586 break; 587 588 default: 589 tk_wr( pdf_wr_1byte( pls->pdfs, c ) ); 590 tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) ); 591 } 592 } 593 594 //-------------------------------------------------------------------------- 595 // tk_XorMod() 596 // 597 // enter (mod = 1) or leave (mod = 0) xor mode 598 // 599 //-------------------------------------------------------------------------- 600 601 static void 602 tk_XorMod( PLStream *pls, PLINT *ptr ) 603 { 604 if ( *ptr != 0 ) 605 server_cmd( pls, "$plwidget cmd plxormod 1 st", 1 ); 606 else 607 server_cmd( pls, "$plwidget cmd plxormod 0 st", 1 ); 608 } 609 610 611 //-------------------------------------------------------------------------- 612 // GetCursor() 613 // 614 // Waits for a graphics input event and returns coordinates. 615 //-------------------------------------------------------------------------- 616 617 static void 618 GetCursor( PLStream *pls, PLGraphicsIn *ptr ) 619 { 620 TkDev *dev = (TkDev *) pls->dev; 621 PLGraphicsIn *gin = &( dev->gin ); 622 623 // Initialize 624 625 plGinInit( gin ); 626 dev->locate_mode = LOCATE_INVOKED_VIA_API; 627 plD_esc_tk( pls, PLESC_FLUSH, NULL ); 628 server_cmd( pls, "$plwidget configure -xhairs on", 1 ); 629 630 // Run event loop until a point is selected 631 632 while ( gin->pX < 0 && dev->locate_mode ) 633 { 634 Tk_DoOneEvent( 0 ); 635 } 636 637 // Clean up 638 639 server_cmd( pls, "$plwidget configure -xhairs off", 1 ); 640 *ptr = *gin; 641 } 642 643 //-------------------------------------------------------------------------- 644 // tk_di 645 // 646 // Process driver interface command. 647 // Just send the command to the remote PLplot library. 648 //-------------------------------------------------------------------------- 649 650 static void 651 tk_di( PLStream *pls ) 652 { 653 TkDev *dev = (TkDev *) pls->dev; 654 char str[STR_LEN]; 655 656 dbug_enter( "tk_di" ); 657 658 // Safety feature, should never happen 659 660 if ( dev == NULL ) 661 { 662 plabort( "tk_di: Illegal call to driver (not yet initialized)" ); 663 return; 664 } 665 666 // Flush the buffer before proceeding 667 668 flush_output( pls ); 669 670 // Change orientation 671 672 if ( pls->difilt & PLDI_ORI ) 673 { 674 snprintf( str, STR_LEN, "%f", pls->diorot ); 675 Tcl_SetVar( dev->interp, "rot", str, 0 ); 676 677 server_cmd( pls, "$plwidget cmd plsetopt -ori $rot", 1 ); 678 pls->difilt &= ~PLDI_ORI; 679 } 680 681 // Change window into plot space 682 683 if ( pls->difilt & PLDI_PLT ) 684 { 685 snprintf( str, STR_LEN, "%f", pls->dipxmin ); 686 Tcl_SetVar( dev->interp, "xl", str, 0 ); 687 snprintf( str, STR_LEN, "%f", pls->dipymin ); 688 Tcl_SetVar( dev->interp, "yl", str, 0 ); 689 snprintf( str, STR_LEN, "%f", pls->dipxmax ); 690 Tcl_SetVar( dev->interp, "xr", str, 0 ); 691 snprintf( str, STR_LEN, "%f", pls->dipymax ); 692 Tcl_SetVar( dev->interp, "yr", str, 0 ); 693 694 server_cmd( pls, "$plwidget cmd plsetopt -wplt $xl,$yl,$xr,$yr", 1 ); 695 pls->difilt &= ~PLDI_PLT; 696 } 697 698 // Change window into device space 699 700 if ( pls->difilt & PLDI_DEV ) 701 { 702 snprintf( str, STR_LEN, "%f", pls->mar ); 703 Tcl_SetVar( dev->interp, "mar", str, 0 ); 704 snprintf( str, STR_LEN, "%f", pls->aspect ); 705 Tcl_SetVar( dev->interp, "aspect", str, 0 ); 706 snprintf( str, STR_LEN, "%f", pls->jx ); 707 Tcl_SetVar( dev->interp, "jx", str, 0 ); 708 snprintf( str, STR_LEN, "%f", pls->jy ); 709 Tcl_SetVar( dev->interp, "jy", str, 0 ); 710 711 server_cmd( pls, "$plwidget cmd plsetopt -mar $mar", 1 ); 712 server_cmd( pls, "$plwidget cmd plsetopt -a $aspect", 1 ); 713 server_cmd( pls, "$plwidget cmd plsetopt -jx $jx", 1 ); 714 server_cmd( pls, "$plwidget cmd plsetopt -jy $jy", 1 ); 715 pls->difilt &= ~PLDI_DEV; 716 } 717 718 // Update view 719 720 server_cmd( pls, "update", 1 ); 721 server_cmd( pls, "plw::update_view $plwindow", 1 ); 722 } 723 724 //-------------------------------------------------------------------------- 725 // tk_fill() 726 // 727 // Fill polygon described in points pls->dev_x[] and pls->dev_y[]. 728 //-------------------------------------------------------------------------- 729 730 static void 731 tk_fill( PLStream *pls ) 732 { 733 PLDev *dev = (PLDev *) pls->dev; 734 735 dbug_enter( "tk_fill" ); 736 737 tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->dev_npts ) ); 738 739 tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) pls->dev_x, pls->dev_npts ) ); 740 tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) pls->dev_y, pls->dev_npts ) ); 741 742 dev->xold = PL_UNDEFINED; 743 dev->yold = PL_UNDEFINED; 744 } 745 746 //-------------------------------------------------------------------------- 747 // tk_start 748 // 749 // Create TCL interpreter and spawn off server process. 750 // Each stream that uses the tk driver gets its own interpreter. 751 //-------------------------------------------------------------------------- 752 753 static void 754 tk_start( PLStream *pls ) 755 { 756 TkDev *dev = (TkDev *) pls->dev; 757 758 dbug_enter( "tk_start" ); 759 760 // Instantiate a TCL interpreter, and get rid of the exec command 761 762 dev->interp = Tcl_CreateInterp(); 763 764 if ( Tcl_Init( dev->interp ) != TCL_OK ) 765 { 766 fprintf( stderr, "%s\n", Tcl_GetStringResult( dev->interp ) ); 767 abort_session( pls, "Unable to initialize Tcl" ); 768 } 769 770 tcl_cmd( pls, "rename exec {}" ); 771 772 // Set top level window name & initialize 773 774 set_windowname( pls ); 775 if ( pls->dp ) 776 { 777 Tcl_SetVar( dev->interp, "dp", "1", TCL_GLOBAL_ONLY ); 778 dev->updatecmd = "dp_update"; 779 } 780 else 781 { 782 Tcl_SetVar( dev->interp, "dp", "0", TCL_GLOBAL_ONLY ); 783 784 // tk_init needs this. Use pls->FileName first, then DISPLAY, then :0.0 785 786 if ( pls->FileName != NULL ) 787 Tcl_SetVar2( dev->interp, "env", "DISPLAY", pls->FileName, TCL_GLOBAL_ONLY ); 788 else if ( getenv( "DISPLAY" ) != NULL ) 789 Tcl_SetVar2( dev->interp, "env", "DISPLAY", getenv( "DISPLAY" ), TCL_GLOBAL_ONLY ); // tk_init need this 790 else 791 Tcl_SetVar2( dev->interp, "env", "DISPLAY", "unix:0.0", TCL_GLOBAL_ONLY ); // tk_init need this 792 793 dev->updatecmd = "update"; 794 if ( pltk_toplevel( &dev->w, dev->interp ) ) 795 abort_session( pls, "Unable to create top-level window" ); 796 } 797 798 // Eval startup procs 799 800 if ( pltkdriver_Init( pls ) != TCL_OK ) 801 { 802 abort_session( pls, "" ); 803 } 804 805 if ( pls->debug ) 806 tcl_cmd( pls, "global auto_path; puts \"auto_path: $auto_path\"" ); 807 808 // Other initializations. 809 // Autoloaded, so the user can customize it if desired 810 811 tcl_cmd( pls, "plclient_init" ); 812 813 // A different way to customize the interface. 814 // E.g. used by plrender to add a back page button. 815 816 if ( drvoptcmd ) 817 tcl_cmd( pls, drvoptcmd ); 818 819 // Initialize server process 820 821 init_server( pls ); 822 823 // By now we should be done with all autoloaded procs, so blow away 824 // the open command just in case security has been compromised 825 826 tcl_cmd( pls, "rename open {}" ); 827 tcl_cmd( pls, "rename rename {}" ); 828 829 // Initialize widgets 830 831 plwindow_init( pls ); 832 833 // Initialize data link 834 835 link_init( pls ); 836 837 return; 838 } 839 840 //-------------------------------------------------------------------------- 841 // tk_stop 842 // 843 // Normal termination & cleanup. 844 //-------------------------------------------------------------------------- 845 846 static void 847 tk_stop( PLStream *pls ) 848 { 849 TkDev *dev = (TkDev *) pls->dev; 850 851 dbug_enter( "tk_stop" ); 852 853 // Safety check for out of control code 854 855 if ( dev->pass_thru ) 856 return; 857 858 dev->pass_thru = 1; 859 860 // Kill plserver 861 862 tcl_cmd( pls, "plclient_link_end" ); 863 864 // Wait for child process to complete 865 866 if ( dev->child_pid ) 867 { 868 waitpid( dev->child_pid, NULL, 0 ); 869 // 870 // problems if parent has not caught/ignore SIGCHLD. Returns -1 and errno=EINTR 871 // if (waitpid(dev->child_pid, NULL, 0) != dev->child_pid) 872 // fprintf(stderr, "tk_stop: waidpid error"); 873 // 874 } 875 876 // Blow away interpreter 877 878 Tcl_DeleteInterp( dev->interp ); 879 dev->interp = NULL; 880 881 // Free up memory and other miscellanea 882 883 pdf_close( pls->pdfs ); 884 if ( dev->iodev != NULL ) 885 { 886 if ( dev->iodev->file != NULL ) 887 plCloseFile( pls ); 888 889 free( (void *) dev->iodev ); 890 } 891 free_mem( dev->cmdbuf ); 892 } 893 894 //-------------------------------------------------------------------------- 895 // abort_session 896 // 897 // Terminates with an error. 898 // Cleanup is done here, and once pls->level is cleared the driver will 899 // never be called again. 900 //-------------------------------------------------------------------------- 901 902 static void 903 abort_session( PLStream *pls, const char *msg ) 904 { 905 TkDev *dev = (TkDev *) pls->dev; 906 907 dbug_enter( "abort_session" ); 908 909 // Safety check for out of control code 910 911 if ( dev->pass_thru ) 912 return; 913 914 tk_stop( pls ); 915 pls->level = 0; 916 917 plexit( msg ); 918 } 919 920 //-------------------------------------------------------------------------- 921 // pltkdriver_Init 922 // 923 // Performs PLplot/TK driver-specific Tcl initialization. 924 //-------------------------------------------------------------------------- 925 926 static int 927 pltkdriver_Init( PLStream *pls ) 928 { 929 TkDev *dev = (TkDev *) pls->dev; 930 Tcl_Interp *interp = (Tcl_Interp *) dev->interp; 931 932 // 933 // Call the init procedures for included packages. Each call should 934 // look like this: 935 // 936 // if (Mod_Init(interp) == TCL_ERROR) { 937 // return TCL_ERROR; 938 // } 939 // 940 // where "Mod" is the name of the module. 941 // 942 943 if ( Tcl_Init( interp ) == TCL_ERROR ) 944 { 945 return TCL_ERROR; 946 } 947 #ifdef PLD_dp 948 if ( pls->dp ) 949 { 950 if ( Tdp_Init( interp ) == TCL_ERROR ) 951 { 952 return TCL_ERROR; 953 } 954 } 955 #endif 956 957 // 958 // Call Tcl_CreateCommand for application-specific commands, if 959 // they weren't already created by the init procedures called above. 960 // 961 962 Tcl_CreateCommand( interp, "wait_until", (Tcl_CmdProc *) plWait_Until, 963 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL ); 964 965 #ifdef PLD_dp 966 if ( pls->dp ) 967 { 968 Tcl_CreateCommand( interp, "host_id", (Tcl_CmdProc *) plHost_ID, 969 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL ); 970 } 971 #endif 972 973 Tcl_CreateCommand( interp, "abort", (Tcl_CmdProc *) Abort, 974 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL ); 975 976 Tcl_CreateCommand( interp, "plfinfo", (Tcl_CmdProc *) Plfinfo, 977 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL ); 978 979 Tcl_CreateCommand( interp, "keypress", (Tcl_CmdProc *) KeyEH, 980 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL ); 981 982 Tcl_CreateCommand( interp, "buttonpress", (Tcl_CmdProc *) ButtonEH, 983 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL ); 984 985 // Set some relevant interpreter variables 986 987 if ( !pls->dp ) 988 tcl_cmd( pls, "set client_name [winfo name .]" ); 989 990 if ( pls->server_name != NULL ) 991 Tcl_SetVar( interp, "server_name", pls->server_name, 0 ); 992 993 if ( pls->server_host != NULL ) 994 Tcl_SetVar( interp, "server_host", pls->server_host, 0 ); 995 996 if ( pls->server_port != NULL ) 997 Tcl_SetVar( interp, "server_port", pls->server_port, 0 ); 998 999 // Set up auto_path 1000 1001 if ( pls_auto_path( interp ) == TCL_ERROR ) 1002 return TCL_ERROR; 1003 1004 return TCL_OK; 1005 } 1006 1007 //-------------------------------------------------------------------------- 1008 // init_server 1009 // 1010 // Starts interaction with server process, launching it if necessary. 1011 // 1012 // There are several possibilities we must account for, depending on the 1013 // message protocol, input flags, and whether plserver is already running 1014 // or not. From the point of view of the code, they are: 1015 // 1016 // 1. Driver: tk 1017 // Flags: <none> 1018 // Meaning: need to start up plserver (same host) 1019 // Actions: fork plserver, passing it our TK main window name 1020 // for communication. Once started, plserver will send 1021 // back its main window name. 1022 // 1023 // 2. Driver: dp 1024 // Flags: <none> 1025 // Meaning: need to start up plserver (same host) 1026 // Actions: fork plserver, passing it our Tcl-DP communication port 1027 // for communication. Once started, plserver will send 1028 // back its created message port number. 1029 // 1030 // 3. Driver: tk 1031 // Flags: -server_name 1032 // Meaning: plserver already running (same host) 1033 // Actions: communicate to plserver our TK main window name. 1034 // 1035 // 4. Driver: dp 1036 // Flags: -server_port 1037 // Meaning: plserver already running (same host) 1038 // Actions: communicate to plserver our Tcl-DP port number. 1039 // 1040 // 5. Driver: dp 1041 // Flags: -server_host 1042 // Meaning: need to start up plserver (remote host) 1043 // Actions: rsh (remsh) plserver, passing it our host ID and Tcl-DP 1044 // port for communication. Once started, plserver will send 1045 // back its created message port number. 1046 // 1047 // 6. Driver: dp 1048 // Flags: -server_host -server_port 1049 // Meaning: plserver already running (remote host) 1050 // Actions: communicate to remote plserver our host ID and Tcl-DP 1051 // port number. 1052 // 1053 // For a bit more flexibility, you can change the name of the process 1054 // invoked from "plserver" to something else, using the -plserver flag. 1055 // 1056 // The startup procedure involves some rather involved handshaking between 1057 // client and server. This is made easier by using the Tcl variables: 1058 // 1059 // client_host client_port server_host server_port 1060 // 1061 // when using Tcl-DP sends and 1062 // 1063 // client_name server_name 1064 // 1065 // when using TK sends. The global Tcl variables 1066 // 1067 // client server 1068 // 1069 // are used as the defining identification for the client and server 1070 // respectively -- they denote the main window name when TK sends are used 1071 // and the respective process's listening socket when Tcl-DP sends are 1072 // used. Note that in the former case, $client is just the same as 1073 // $client_name. In addition, since the server may need to communicate 1074 // with many different client processes, every command to the server 1075 // contains the sender's client id (so it knows how to report back if 1076 // necessary). Thus the Tk driver's interpreter must know both $server as 1077 // well as $client. It is most convenient to set $client from the server, 1078 // as a way to signal that communication has been set up and it is safe to 1079 // proceed. 1080 // 1081 // Often it is necessary to use constructs such as [list $server] instead 1082 // of just $server. This occurs since you could have multiple copies 1083 // running on the display (resulting in names of the form "plserver #2", 1084 // etc). Embedding such a string in a "[list ...]" construct prevents the 1085 // string from being interpreted as two separate strings. 1086 //-------------------------------------------------------------------------- 1087 1088 static void 1089 init_server( PLStream *pls ) 1090 { 1091 int server_exists = 0; 1092 1093 dbug_enter( "init_server" ); 1094 1095 pldebug( "init_server", "%s -- PID: %d, PGID: %d, PPID: %d\n", 1096 __FILE__, (int) getpid(), (int) getpgrp(), (int) getppid() ); 1097 1098 // If no means of communication provided, need to launch plserver 1099 1100 if ( ( !pls->dp && pls->server_name != NULL ) || 1101 ( pls->dp && pls->server_port != NULL ) ) 1102 server_exists = 1; 1103 1104 // So launch it 1105 1106 if ( !server_exists ) 1107 launch_server( pls ); 1108 1109 // Set up communication channel to server 1110 1111 if ( pls->dp ) 1112 { 1113 tcl_cmd( pls, 1114 "set server [dp_MakeRPCClient $server_host $server_port]" ); 1115 } 1116 else 1117 { 1118 tcl_cmd( pls, "set server $server_name" ); 1119 } 1120 1121 // If server didn't need launching, contact it here 1122 1123 if ( server_exists ) 1124 tcl_cmd( pls, "plclient_link_init" ); 1125 } 1126 1127 //-------------------------------------------------------------------------- 1128 // launch_server 1129 // 1130 // Launches plserver, locally or remotely. 1131 //-------------------------------------------------------------------------- 1132 1133 static void 1134 launch_server( PLStream *pls ) 1135 { 1136 TkDev *dev = (TkDev *) pls->dev; 1137 const char *argv[20]; 1138 char *plserver_exec = NULL, *ptr; 1139 char *tmp = NULL; 1140 int i; 1141 1142 dbug_enter( "launch_server" ); 1143 1144 if ( pls->plserver == NULL ) 1145 pls->plserver = plstrdup( NAME_plserver ); 1146 1147 // Build argument list 1148 1149 i = 0; 1150 1151 // If we're doing a rsh, need to set up its arguments first. 1152 1153 if ( pls->dp && pls->server_host != NULL ) 1154 { 1155 argv[i++] = pls->server_host; // Host name for rsh 1156 1157 if ( pls->user != NULL ) 1158 { 1159 argv[i++] = "-l"; 1160 argv[i++] = pls->user; // User name on remote node 1161 } 1162 } 1163 1164 // The invoked executable name comes next 1165 1166 argv[i++] = pls->plserver; 1167 1168 // The rest are arguments to plserver 1169 1170 argv[i++] = "-child"; // Tell plserver its ancestry 1171 1172 argv[i++] = "-e"; // Startup script 1173 argv[i++] = "plserver_init"; 1174 1175 // aaahhh. This is it! Without the next statements, control is either 1176 // in tk or octave, because tcl/tk was in interative mode (I think). 1177 // This had the inconvenient of having to press the enter key or cliking a 1178 // mouse button in the plot window after every plot. 1179 // 1180 // This couldn't be done with 1181 // Tcl_SetVar(dev->interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); 1182 // after plserver has been launched? It doesnt work, hoewever. 1183 // Tk_CreateFileHandler (0, TK_READABLE, NULL, 0) doesnt work also 1184 // 1185 1186 argv[i++] = "-file"; // Startup file 1187 if ( pls->tk_file ) 1188 argv[i++] = pls->tk_file; 1189 else 1190 argv[i++] = "/dev/null"; 1191 1192 1193 // 1194 // Give interpreter the base name of the plwindow. 1195 // Useful to know the interpreter name 1196 // 1197 1198 if ( pls->plwindow != NULL ) 1199 { 1200 char *t; 1201 argv[i++] = "-name"; // plserver name 1202 tmp = plstrdup( pls->plwindow + 1 ); // get rid of the initial dot 1203 argv[i++] = tmp; 1204 if ( ( t = strchr( tmp, '.' ) ) != NULL ) 1205 *t = '\0'; // and keep only the base name 1206 } 1207 else 1208 { 1209 argv[i++] = "-name"; // plserver name 1210 argv[i++] = pls->program; 1211 } 1212 1213 if ( pls->auto_path != NULL ) 1214 { 1215 argv[i++] = "-auto_path"; // Additional directory(s) 1216 argv[i++] = pls->auto_path; // to autoload 1217 } 1218 1219 if ( pls->geometry != NULL ) 1220 { 1221 argv[i++] = "-geometry"; // Top level window geometry 1222 argv[i++] = pls->geometry; 1223 } 1224 1225 // If communicating via Tcl-DP, specify communications port id 1226 // If communicating via TK send, specify main window name 1227 1228 if ( pls->dp ) 1229 { 1230 argv[i++] = "-client_host"; 1231 argv[i++] = Tcl_GetVar( dev->interp, "client_host", TCL_GLOBAL_ONLY ); 1232 1233 argv[i++] = "-client_port"; 1234 argv[i++] = Tcl_GetVar( dev->interp, "client_port", TCL_GLOBAL_ONLY ); 1235 1236 if ( pls->user != NULL ) 1237 { 1238 argv[i++] = "-l"; 1239 argv[i++] = pls->user; 1240 } 1241 } 1242 else 1243 { 1244 argv[i++] = "-client_name"; 1245 argv[i++] = Tcl_GetVar( dev->interp, "client_name", TCL_GLOBAL_ONLY ); 1246 } 1247 1248 // The display absolutely must be set if invoking a remote server (by rsh) 1249 // Use the DISPLAY environmental, if set. Otherwise use the remote host. 1250 1251 if ( pls->FileName != NULL ) 1252 { 1253 argv[i++] = "-display"; 1254 argv[i++] = pls->FileName; 1255 } 1256 else if ( pls->dp && pls->server_host != NULL ) 1257 { 1258 argv[i++] = "-display"; 1259 if ( ( ptr = getenv( "DISPLAY" ) ) != NULL ) 1260 argv[i++] = ptr; 1261 else 1262 argv[i++] = "unix:0.0"; 1263 } 1264 1265 // Add terminating null 1266 1267 argv[i++] = NULL; 1268 #ifdef DEBUG 1269 if ( pls->debug ) 1270 { 1271 int j; 1272 fprintf( stderr, "argument list: \n " ); 1273 for ( j = 0; j < i; j++ ) 1274 fprintf( stderr, "%s ", argv[j] ); 1275 fprintf( stderr, "\n" ); 1276 } 1277 #endif 1278 1279 // Start server process 1280 // It's a fork/rsh if on a remote machine 1281 1282 if ( pls->dp && pls->server_host != NULL ) 1283 { 1284 if ( ( dev->child_pid = fork() ) < 0 ) 1285 { 1286 abort_session( pls, "Unable to fork server process" ); 1287 } 1288 else if ( dev->child_pid == 0 ) 1289 { 1290 fprintf( stderr, "Starting up %s on node %s\n", pls->plserver, 1291 pls->server_host ); 1292 1293 if ( execvp( "rsh", (char * const *) argv ) ) 1294 { 1295 perror( "Unable to exec server process" ); 1296 _exit( 1 ); 1297 } 1298 } 1299 } 1300 1301 // Running locally, so its a fork/exec 1302 1303 else 1304 { 1305 plserver_exec = plFindCommand( pls->plserver ); 1306 if ( ( plserver_exec == NULL ) || ( dev->child_pid = fork() ) < 0 ) 1307 { 1308 abort_session( pls, "Unable to fork server process" ); 1309 } 1310 else if ( dev->child_pid == 0 ) 1311 { 1312 // Don't kill plserver on a ^C if pls->server_nokill is set 1313 1314 if ( pls->server_nokill ) 1315 { 1316 sigset_t set; 1317 sigemptyset( &set ); 1318 sigaddset( &set, SIGINT ); 1319 if ( sigprocmask( SIG_BLOCK, &set, 0 ) < 0 ) 1320 fprintf( stderr, "PLplot: sigprocmask failure\n" ); 1321 } 1322 1323 pldebug( "launch_server", "Starting up %s\n", plserver_exec ); 1324 if ( execv( plserver_exec, (char * const *) argv ) ) 1325 { 1326 fprintf( stderr, "Unable to exec server process.\n" ); 1327 _exit( 1 ); 1328 } 1329 } 1330 free_mem( plserver_exec ); 1331 } 1332 free_mem( tmp ); 1333 1334 // Wait for server to set up return communication channel 1335 1336 tk_wait( pls, "[info exists client]" ); 1337 } 1338 1339 //-------------------------------------------------------------------------- 1340 // plwindow_init 1341 // 1342 // Configures the widget hierarchy we are sending the data stream to. 1343 // 1344 // If a widget name (identifying the actual widget or a container widget) 1345 // hasn't been supplied already we assume it needs to be created. 1346 // 1347 // In order to achieve maximum flexibility, the PLplot tk driver requires 1348 // only that certain TCL procs must be defined in the server interpreter. 1349 // These can be used to set up the desired widget configuration. The procs 1350 // invoked from this driver currently include: 1351 // 1352 // $plw_create_proc Creates the widget environment 1353 // $plw_start_proc Does any remaining startup necessary 1354 // $plw_end_proc Prepares for shutdown 1355 // $plw_flash_proc Invoked when waiting for page advance 1356 // 1357 // Since all of these are interpreter variables, they can be trivially 1358 // changed by the user. 1359 // 1360 // Each of these utility procs is called with a widget name ($plwindow) 1361 // as argument. "plwindow" is set from the value of pls->plwindow, and 1362 // if null is generated from the name of the client main window (to 1363 // ensure uniqueness). $plwindow usually indicates the container frame 1364 // for the actual PLplot widget, but can be arbitrary -- as long as the 1365 // usage in all the TCL procs is consistent. 1366 // 1367 // In order that the TK driver be able to invoke the actual PLplot 1368 // widget, the proc "$plw_create_proc" deposits the widget name in the local 1369 // interpreter variable "plwidget". 1370 //-------------------------------------------------------------------------- 1371 1372 static void 1373 plwindow_init( PLStream *pls ) 1374 { 1375 TkDev *dev = (TkDev *) pls->dev; 1376 char command[CMD_LEN]; 1377 unsigned int bg; 1378 char *tmp; 1379 int i, n; 1380 1381 dbug_enter( "plwindow_init" ); 1382 1383 // Set tcl plwindow variable to be pls->plwindow with a . prepended and 1384 // and with ' ' replaced by '_' and all other '.' by '_' to avoid 1385 // quoting and bad window name problems. Also avoid name starting with 1386 // an upper case letter. 1387 n = (int) strlen( pls->plwindow ) + 1; 1388 tmp = (char *) malloc( sizeof ( char ) * (size_t) ( n + 1 ) ); 1389 sprintf( tmp, ".%s", pls->plwindow ); 1390 for ( i = 1; i < n; i++ ) 1391 { 1392 if ( ( tmp[i] == ' ' ) || ( tmp[i] == '.' ) ) 1393 tmp[i] = '_'; 1394 } 1395 if ( isupper( tmp[1] ) ) 1396 tmp[1] = tolower( tmp[1] ); 1397 Tcl_SetVar( dev->interp, "plwindow", tmp, 0 ); 1398 free( tmp ); 1399 1400 // Create the plframe widget & anything else you want with it. 1401 1402 server_cmd( pls, 1403 "$plw_create_proc $plwindow [list $client]", 1 ); 1404 1405 tk_wait( pls, "[info exists plwidget]" ); 1406 1407 // Now we should have the actual PLplot widget name in $plwidget 1408 // Configure remote PLplot stream. 1409 1410 // Configure background color if anything other than black 1411 // The default color is handled from a resource setting in plconfig.tcl 1412 1413 bg = (unsigned int) ( pls->cmap0[0].b | ( pls->cmap0[0].g << 8 ) | ( pls->cmap0[0].r << 16 ) ); 1414 if ( bg > 0 ) 1415 { 1416 snprintf( command, CMD_LEN, "$plwidget configure -plbg #%06x", bg ); 1417 server_cmd( pls, command, 0 ); 1418 } 1419 1420 // nopixmap option 1421 1422 if ( pls->nopixmap ) 1423 server_cmd( pls, "$plwidget cmd plsetopt -nopixmap", 0 ); 1424 1425 // debugging 1426 1427 if ( pls->debug ) 1428 server_cmd( pls, "$plwidget cmd plsetopt -debug", 0 ); 1429 1430 // double buffering 1431 1432 if ( pls->db ) 1433 server_cmd( pls, "$plwidget cmd plsetopt -db", 0 ); 1434 1435 // color map options 1436 1437 if ( pls->ncol0 ) 1438 { 1439 snprintf( command, CMD_LEN, "$plwidget cmd plsetopt -ncol0 %d", pls->ncol0 ); 1440 server_cmd( pls, command, 0 ); 1441 } 1442 1443 if ( pls->ncol1 ) 1444 { 1445 snprintf( command, CMD_LEN, "$plwidget cmd plsetopt -ncol1 %d", pls->ncol1 ); 1446 server_cmd( pls, command, 0 ); 1447 } 1448 1449 // Start up remote PLplot 1450 1451 server_cmd( pls, "$plw_start_proc $plwindow", 1 ); 1452 tk_wait( pls, "[info exists widget_is_ready]" ); 1453 } 1454 1455 //-------------------------------------------------------------------------- 1456 // set_windowname 1457 // 1458 // Set up top level window name. Use pls->program, modified appropriately. 1459 //-------------------------------------------------------------------------- 1460 1461 static void 1462 set_windowname( PLStream *pls ) 1463 { 1464 const char *pname; 1465 int i; 1466 size_t maxlen; 1467 1468 // Set to "plclient" if not initialized via plargs or otherwise 1469 1470 if ( pls->program == NULL ) 1471 pls->program = plstrdup( "plclient" ); 1472 1473 // Eliminate any leading path specification 1474 1475 pname = strrchr( pls->program, '/' ); 1476 if ( pname ) 1477 pname++; 1478 else 1479 pname = pls->program; 1480 1481 if ( pls->plwindow == NULL ) // dont override -plwindow cmd line option 1482 { 1483 maxlen = strlen( pname ) + 10; 1484 pls->plwindow = (char *) malloc( maxlen * sizeof ( char ) ); 1485 1486 // Allow for multiple widgets created by multiple streams 1487 1488 if ( pls->ipls == 0 ) 1489 snprintf( pls->plwindow, maxlen, ".%s", pname ); 1490 else 1491 snprintf( pls->plwindow, maxlen, ".%s_%d", pname, (int) pls->ipls ); 1492 1493 // Replace any ' 's with '_'s to avoid quoting problems. 1494 // Replace any '.'s (except leading) with '_'s to avoid bad window names. 1495 1496 for ( i = 0; i < (int) strlen( pls->plwindow ); i++ ) 1497 { 1498 if ( pls->plwindow[i] == ' ' ) 1499 pls->plwindow[i] = '_'; 1500 if ( i == 0 ) 1501 continue; 1502 if ( pls->plwindow[i] == '.' ) 1503 pls->plwindow[i] = '_'; 1504 } 1505 } 1506 } 1507 1508 //-------------------------------------------------------------------------- 1509 // link_init 1510 // 1511 // Initializes the link between the client and the PLplot widget for 1512 // data transfer. Defaults to a FIFO when the TK driver is selected and 1513 // a socket when the DP driver is selected. 1514 //-------------------------------------------------------------------------- 1515 1516 static void 1517 link_init( PLStream *pls ) 1518 { 1519 TkDev *dev = (TkDev *) pls->dev; 1520 PLiodev *iodev = (PLiodev *) dev->iodev; 1521 size_t bufmax = (size_t) ( pls->bufmax * 1.2 ); 1522 const char *dirname = NULL; 1523 1524 dbug_enter( "link_init" ); 1525 1526 // Create FIFO for data transfer to the plframe widget 1527 1528 if ( !pls->dp ) 1529 { 1530 // This uses the pl_create_tempfifo function to create 1531 // the fifo in a safe manner by first creating a private 1532 // temporary directory. 1533 iodev->fileName = pl_create_tempfifo( (const char **) &iodev->fileName, &dirname ); 1534 if ( dirname == NULL || iodev->fileName == NULL ) 1535 abort_session( pls, "mkfifo error" ); 1536 1537 // Tell plframe widget to open FIFO (for reading). 1538 1539 Tcl_SetVar( dev->interp, "fifoname", iodev->fileName, 0 ); 1540 server_cmd( pls, "$plwidget openlink fifo $fifoname", 1 ); 1541 1542 // Open the FIFO for writing 1543 // This will block until the server opens it for reading 1544 1545 if ( ( iodev->fd = open( iodev->fileName, O_WRONLY ) ) == -1 ) 1546 abort_session( pls, "Error opening fifo for write" ); 1547 1548 // Create stream interface (C file handle) to FIFO 1549 1550 iodev->type = 0; 1551 iodev->typeName = "fifo"; 1552 iodev->file = fdopen( iodev->fd, "wb" ); 1553 1554 // Unlink FIFO so that it isn't left around if program crashes. 1555 // This also ensures no other program can mess with it. 1556 1557 if ( unlink( iodev->fileName ) == -1 ) 1558 abort_session( pls, "Error removing fifo" ); 1559 free( (void *) iodev->fileName ); 1560 iodev->fileName = NULL; 1561 if ( rmdir( dirname ) == -1 ) 1562 abort_session( pls, "Error removing temporary directory" ); 1563 free( (void *) dirname ); 1564 } 1565 1566 // Create socket for data transfer to the plframe widget 1567 1568 else 1569 { 1570 iodev->type = 1; 1571 iodev->typeName = "socket"; 1572 tcl_cmd( pls, "plclient_dp_init" ); 1573 iodev->fileHandle = Tcl_GetVar( dev->interp, "data_sock", 0 ); 1574 1575 if ( Tcl_GetOpenFile( dev->interp, iodev->fileHandle, 1576 0, 1, ( ClientData ) & iodev->file ) != TCL_OK ) 1577 { 1578 fprintf( stderr, "Cannot get file info:\n\t %s\n", 1579 Tcl_GetStringResult( dev->interp ) ); 1580 abort_session( pls, "" ); 1581 } 1582 iodev->fd = fileno( iodev->file ); 1583 } 1584 1585 // Create data buffer 1586 1587 pls->pdfs = pdf_bopen( NULL, (size_t) bufmax ); 1588 } 1589 1590 //-------------------------------------------------------------------------- 1591 // WaitForPage() 1592 // 1593 // Waits for a page advance. 1594 //-------------------------------------------------------------------------- 1595 1596 static void 1597 WaitForPage( PLStream *pls ) 1598 { 1599 TkDev *dev = (TkDev *) pls->dev; 1600 1601 dbug_enter( "WaitForPage" ); 1602 1603 while ( !dev->exit_eventloop ) 1604 { 1605 Tk_DoOneEvent( 0 ); 1606 } 1607 dev->exit_eventloop = 0; 1608 } 1609 1610 //-------------------------------------------------------------------------- 1611 // CheckForEvents() 1612 // 1613 // A front-end to HandleEvents(), which is only called if certain conditions 1614 // are satisfied: 1615 // 1616 // - only check for events and process them every dev->max_instr times this 1617 // function is called (good for performance since performing an update is 1618 // a nontrivial performance hit). 1619 //-------------------------------------------------------------------------- 1620 1621 static void 1622 CheckForEvents( PLStream *pls ) 1623 { 1624 TkDev *dev = (TkDev *) pls->dev; 1625 1626 if ( ++dev->instr % dev->max_instr == 0 ) 1627 { 1628 dev->instr = 0; 1629 HandleEvents( pls ); 1630 } 1631 } 1632 1633 //-------------------------------------------------------------------------- 1634 // HandleEvents() 1635 // 1636 // Just a front-end to the update command, for use when not actually waiting 1637 // for an event but only checking the event queue. 1638 //-------------------------------------------------------------------------- 1639 1640 static void 1641 HandleEvents( PLStream *pls ) 1642 { 1643 TkDev *dev = (TkDev *) pls->dev; 1644 1645 dbug_enter( "HandleEvents" ); 1646 1647 Tcl_VarEval( dev->interp, dev->updatecmd, (char **) NULL ); 1648 } 1649 1650 //-------------------------------------------------------------------------- 1651 // flush_output() 1652 // 1653 // Sends graphics instructions to the {FIFO|socket} via a packet send. 1654 // 1655 // The packet i/o routines are modified versions of the ones from the 1656 // Tcl-DP package. They have been altered to take a pointer to a PDFstrm 1657 // struct, and read-to or write-from pdfs->buffer. The length of the 1658 // buffer is stored in pdfs->bp (the original Tcl-DP routine assumes the 1659 // message is character data and uses strlen). Also, they can 1660 // send/receive from either a fifo or a socket. 1661 //-------------------------------------------------------------------------- 1662 1663 static void 1664 flush_output( PLStream *pls ) 1665 { 1666 TkDev *dev = (TkDev *) pls->dev; 1667 PDFstrm *pdfs = (PDFstrm *) pls->pdfs; 1668 1669 dbug_enter( "flush_output" ); 1670 1671 HandleEvents( pls ); 1672 1673 // Send packet -- plserver filehandler will be invoked automatically. 1674 1675 if ( pdfs->bp > 0 ) 1676 { 1677 #ifdef DEBUG_ENTER 1678 pldebug( "flush_output", "%s: Flushing buffer, bytes = %ld\n", 1679 __FILE__, pdfs->bp ); 1680 #endif 1681 if ( pl_PacketSend( dev->interp, dev->iodev, pls->pdfs ) ) 1682 { 1683 fprintf( stderr, "Packet send failed:\n\t %s\n", 1684 Tcl_GetStringResult( dev->interp ) ); 1685 abort_session( pls, "" ); 1686 } 1687 pdfs->bp = 0; 1688 } 1689 } 1690 1691 //-------------------------------------------------------------------------- 1692 // Abort 1693 // 1694 // Just a TCL front-end to abort_session(). 1695 //-------------------------------------------------------------------------- 1696 1697 static int 1698 Abort( ClientData clientData, Tcl_Interp *PL_UNUSED( interp ), int PL_UNUSED( argc ), char **PL_UNUSED( argv ) ) 1699 { 1700 PLStream *pls = (PLStream *) clientData; 1701 1702 dbug_enter( "Abort" ); 1703 1704 abort_session( pls, "" ); 1705 return TCL_OK; 1706 } 1707 1708 //-------------------------------------------------------------------------- 1709 // Plfinfo 1710 // 1711 // Sends info about the server plframe. Usually issued after some 1712 // modification to the plframe is made by the user, such as a resize. 1713 //-------------------------------------------------------------------------- 1714 1715 static int 1716 Plfinfo( ClientData clientData, Tcl_Interp *interp, int argc, char **argv ) 1717 { 1718 PLStream *pls = (PLStream *) clientData; 1719 TkDev *dev = (TkDev *) pls->dev; 1720 int result = TCL_OK; 1721 1722 dbug_enter( "Plfinfo" ); 1723 1724 if ( argc < 3 ) 1725 { 1726 Tcl_AppendResult( interp, "wrong # args: should be \"", 1727 " plfinfo wx wy\"", (char *) NULL ); 1728 result = TCL_ERROR; 1729 } 1730 else 1731 { 1732 dev->width = (unsigned int) atoi( argv[1] ); 1733 dev->height = (unsigned int) atoi( argv[2] ); 1734 #if PHYSICAL 1735 { 1736 PLFLT pxlx = (double) PIXELS_X / dev->width * DPMM; 1737 PLFLT pxly = (double) PIXELS_Y / dev->height * DPMM; 1738 plP_setpxl( pxlx, pxly ); 1739 } 1740 #endif 1741 } 1742 1743 return result; 1744 } 1745 1746 //-------------------------------------------------------------------------- 1747 // KeyEH() 1748 // 1749 // This TCL command handles keyboard events. 1750 //-------------------------------------------------------------------------- 1751 1752 static int 1753 KeyEH( ClientData clientData, Tcl_Interp *interp, int argc, char **argv ) 1754 { 1755 PLStream *pls = (PLStream *) clientData; 1756 TkDev *dev = (TkDev *) pls->dev; 1757 int result; 1758 1759 dbug_enter( "KeyEH" ); 1760 1761 if ( ( result = LookupTkKeyEvent( pls, interp, argc, argv ) ) != TCL_OK ) 1762 return result; 1763 1764 if ( dev->locate_mode ) 1765 LocateKey( pls ); 1766 else 1767 ProcessKey( pls ); 1768 1769 return result; 1770 } 1771 1772 //-------------------------------------------------------------------------- 1773 // ButtonEH() 1774 // 1775 // This TCL command handles button events. 1776 //-------------------------------------------------------------------------- 1777 1778 static int 1779 ButtonEH( ClientData clientData, Tcl_Interp *interp, int argc, char **argv ) 1780 { 1781 PLStream *pls = (PLStream *) clientData; 1782 TkDev *dev = (TkDev *) pls->dev; 1783 int result; 1784 1785 dbug_enter( "ButtonEH" ); 1786 1787 if ( ( result = LookupTkButtonEvent( pls, interp, argc, argv ) ) != TCL_OK ) 1788 return result; 1789 1790 if ( dev->locate_mode ) 1791 LocateButton( pls ); 1792 else 1793 ProcessButton( pls ); 1794 1795 return result; 1796 } 1797 1798 //-------------------------------------------------------------------------- 1799 // LookupTkKeyEvent() 1800 // 1801 // Fills in the PLGraphicsIn from a Tk KeyEvent. 1802 // 1803 // Contents of argv array: 1804 // command name 1805 // keysym value 1806 // keysym state 1807 // absolute x coordinate of cursor 1808 // absolute y coordinate of cursor 1809 // relative x coordinate (normalized to [0.0 1.0]) 1810 // relative y coordinate (normalized to [0.0 1.0]) 1811 // keysym name 1812 // ASCII equivalent (optional) 1813 // 1814 // Note that the keysym name is only used for debugging, and the string is 1815 // not always passed (i.e. the character may not have an ASCII 1816 // representation). 1817 //-------------------------------------------------------------------------- 1818 1819 static int 1820 LookupTkKeyEvent( PLStream *pls, Tcl_Interp *interp, int argc, char **argv ) 1821 { 1822 TkDev *dev = (TkDev *) pls->dev; 1823 PLGraphicsIn *gin = &( dev->gin ); 1824 char *keyname; 1825 1826 dbug_enter( "LookupTkKeyEvent" ); 1827 1828 if ( argc < 8 ) 1829 { 1830 Tcl_AppendResult( interp, "wrong # args: should be \"", 1831 argv[0], " key-value state pX pY dX dY key-name ?ascii-value?\"", 1832 (char *) NULL ); 1833 return TCL_ERROR; 1834 } 1835 1836 gin->keysym = (unsigned int) atol( argv[1] ); 1837 gin->state = (unsigned int) atol( argv[2] ); 1838 gin->pX = atoi( argv[3] ); 1839 gin->pY = atoi( argv[4] ); 1840 gin->dX = atof( argv[5] ); 1841 gin->dY = atof( argv[6] ); 1842 1843 keyname = argv[7]; 1844 1845 gin->string[0] = '\0'; 1846 if ( argc > 8 ) 1847 { 1848 gin->string[0] = argv[8][0]; 1849 gin->string[1] = '\0'; 1850 } 1851 1852 // Fix up keysym value -- see notes in xwin.c about key representation 1853 1854 switch ( gin->keysym ) 1855 { 1856 case XK_BackSpace: 1857 case XK_Tab: 1858 case XK_Linefeed: 1859 case XK_Return: 1860 case XK_Escape: 1861 case XK_Delete: 1862 gin->keysym &= 0xFF; 1863 break; 1864 } 1865 1866 pldebug( "LookupTkKeyEvent", 1867 "KeyEH: stream: %d, Keyname %s, hex %x, ASCII: %s\n", 1868 (int) pls->ipls, keyname, (unsigned int) gin->keysym, gin->string ); 1869 1870 return TCL_OK; 1871 } 1872 1873 //-------------------------------------------------------------------------- 1874 // LookupTkButtonEvent() 1875 // 1876 // Fills in the PLGraphicsIn from a Tk ButtonEvent. 1877 // 1878 // Contents of argv array: 1879 // command name 1880 // button number 1881 // state (decimal string) 1882 // absolute x coordinate 1883 // absolute y coordinate 1884 // relative x coordinate (normalized to [0.0 1.0]) 1885 // relative y coordinate (normalized to [0.0 1.0]) 1886 //-------------------------------------------------------------------------- 1887 1888 static int 1889 LookupTkButtonEvent( PLStream *pls, Tcl_Interp *interp, int argc, char **argv ) 1890 { 1891 TkDev *dev = (TkDev *) pls->dev; 1892 PLGraphicsIn *gin = &( dev->gin ); 1893 1894 dbug_enter( "LookupTkButtonEvent" ); 1895 1896 if ( argc != 7 ) 1897 { 1898 Tcl_AppendResult( interp, "wrong # args: should be \"", 1899 argv[0], " button-number state pX pY dX dY\"", (char *) NULL ); 1900 return TCL_ERROR; 1901 } 1902 1903 gin->button = (unsigned int) atol( argv[1] ); 1904 gin->state = (unsigned int) atol( argv[2] ); 1905 gin->pX = atoi( argv[3] ); 1906 gin->pY = atoi( argv[4] ); 1907 gin->dX = atof( argv[5] ); 1908 gin->dY = atof( argv[6] ); 1909 gin->keysym = 0x20; 1910 1911 pldebug( "LookupTkButtonEvent", 1912 "button %d, state %d, pX: %d, pY: %d, dX: %f, dY: %f\n", 1913 gin->button, gin->state, gin->pX, gin->pY, gin->dX, gin->dY ); 1914 1915 return TCL_OK; 1916 } 1917 1918 //-------------------------------------------------------------------------- 1919 // ProcessKey() 1920 // 1921 // Process keyboard events other than locate input. 1922 //-------------------------------------------------------------------------- 1923 1924 static void 1925 ProcessKey( PLStream *pls ) 1926 { 1927 TkDev *dev = (TkDev *) pls->dev; 1928 PLGraphicsIn *gin = &( dev->gin ); 1929 1930 dbug_enter( "ProcessKey" ); 1931 1932 // Call user keypress event handler. Since this is called first, the user 1933 // can disable all internal event handling by setting key.keysym to 0. 1934 // 1935 if ( pls->KeyEH != NULL ) 1936 ( *pls->KeyEH )( gin, pls->KeyEH_data, &dev->exit_eventloop ); 1937 1938 // Handle internal events 1939 1940 switch ( gin->keysym ) 1941 { 1942 case PLK_Return: 1943 case PLK_Linefeed: 1944 case PLK_Next: 1945 // Advance to next page (i.e. terminate event loop) on a <eol> 1946 // Check for both <CR> and <LF> for portability, also a <Page Down> 1947 dev->exit_eventloop = TRUE; 1948 break; 1949 1950 case 'Q': 1951 // Terminate on a 'Q' (not 'q', since it's too easy to hit by mistake) 1952 tcl_cmd( pls, "abort" ); 1953 break; 1954 1955 case 'L': 1956 // Begin locate mode 1957 dev->locate_mode = LOCATE_INVOKED_VIA_DRIVER; 1958 server_cmd( pls, "$plwidget configure -xhairs on", 1 ); 1959 break; 1960 } 1961 } 1962 1963 //-------------------------------------------------------------------------- 1964 // ProcessButton() 1965 // 1966 // Process ButtonPress events other than locate input. 1967 // On: 1968 // Button1: nothing (except when in locate mode, see ButtonLocate) 1969 // Button2: nothing 1970 // Button3: set page advance flag 1971 //-------------------------------------------------------------------------- 1972 1973 static void 1974 ProcessButton( PLStream *pls ) 1975 { 1976 TkDev *dev = (TkDev *) pls->dev; 1977 PLGraphicsIn *gin = &( dev->gin ); 1978 1979 dbug_enter( "ButtonEH" ); 1980 1981 // Call user event handler. Since this is called first, the user can 1982 // disable all PLplot internal event handling by setting gin->button to 0. 1983 // 1984 if ( pls->ButtonEH != NULL ) 1985 ( *pls->ButtonEH )( gin, pls->ButtonEH_data, &dev->exit_eventloop ); 1986 1987 // Handle internal events 1988 1989 switch ( gin->button ) 1990 { 1991 case Button3: 1992 dev->exit_eventloop = TRUE; 1993 break; 1994 } 1995 } 1996 1997 //-------------------------------------------------------------------------- 1998 // LocateKey() 1999 // 2000 // Front-end to locate handler for KeyPress events. 2001 // Only provides for: 2002 // 2003 // <Escape> Ends locate mode 2004 //-------------------------------------------------------------------------- 2005 2006 static void 2007 LocateKey( PLStream *pls ) 2008 { 2009 TkDev *dev = (TkDev *) pls->dev; 2010 PLGraphicsIn *gin = &( dev->gin ); 2011 2012 // End locate mode on <Escape> 2013 2014 if ( gin->keysym == PLK_Escape ) 2015 { 2016 dev->locate_mode = 0; 2017 server_cmd( pls, "$plwidget configure -xhairs off", 1 ); 2018 plGinInit( gin ); 2019 } 2020 else 2021 { 2022 Locate( pls ); 2023 } 2024 } 2025 2026 //-------------------------------------------------------------------------- 2027 // LocateButton() 2028 // 2029 // Front-end to locate handler for ButtonPress events. 2030 // Only passes control to Locate() for Button1 presses. 2031 //-------------------------------------------------------------------------- 2032 2033 static void 2034 LocateButton( PLStream *pls ) 2035 { 2036 TkDev *dev = (TkDev *) pls->dev; 2037 PLGraphicsIn *gin = &( dev->gin ); 2038 2039 switch ( gin->button ) 2040 { 2041 case Button1: 2042 Locate( pls ); 2043 break; 2044 } 2045 } 2046 2047 //-------------------------------------------------------------------------- 2048 // Locate() 2049 // 2050 // Handles locate mode events. 2051 // 2052 // In locate mode: move cursor to desired location and select by pressing a 2053 // key or by clicking on the mouse (if available). Typically the world 2054 // coordinates of the selected point are reported. 2055 // 2056 // There are two ways to enter Locate mode -- via the API, or via a driver 2057 // command. The API entry point is the call plGetCursor(), which initiates 2058 // locate mode and does not return until input has been obtained. The 2059 // driver entry point is by entering a 'L' while the driver is waiting for 2060 // events. 2061 // 2062 // Locate mode input is reported in one of three ways: 2063 // 1. Through a returned PLGraphicsIn structure, when user has specified a 2064 // locate handler via (*pls->LocateEH). 2065 // 2. Through a returned PLGraphicsIn structure, when locate mode is invoked 2066 // by a plGetCursor() call. 2067 // 3. Through writes to stdout, when locate mode is invoked by a driver 2068 // command and the user has not supplied a locate handler. 2069 // 2070 // Hitting <Escape> will at all times end locate mode. Other keys will 2071 // typically be interpreted as locator input. Selecting a point out of 2072 // bounds will end locate mode unless the user overrides with a supplied 2073 // Locate handler. 2074 //-------------------------------------------------------------------------- 2075 2076 static void 2077 Locate( PLStream *pls ) 2078 { 2079 TkDev *dev = (TkDev *) pls->dev; 2080 PLGraphicsIn *gin = &( dev->gin ); 2081 2082 // Call user locate mode handler if provided 2083 2084 if ( pls->LocateEH != NULL ) 2085 ( *pls->LocateEH )( gin, pls->LocateEH_data, &dev->locate_mode ); 2086 2087 // Use default procedure 2088 2089 else 2090 { 2091 // Try to locate cursor 2092 2093 if ( plTranslateCursor( gin ) ) 2094 { 2095 // If invoked by the API, we're done 2096 // Otherwise send report to stdout 2097 2098 if ( dev->locate_mode == LOCATE_INVOKED_VIA_DRIVER ) 2099 { 2100 pltext(); 2101 if ( gin->keysym < 0xFF && isprint( gin->keysym ) ) 2102 printf( "%f %f %c\n", gin->wX, gin->wY, gin->keysym ); 2103 else 2104 printf( "%f %f 0x%02x\n", gin->wX, gin->wY, gin->keysym ); 2105 2106 plgra(); 2107 } 2108 } 2109 else 2110 { 2111 // Selected point is out of bounds, so end locate mode 2112 2113 dev->locate_mode = 0; 2114 server_cmd( pls, "$plwidget configure -xhairs off", 1 ); 2115 } 2116 } 2117 } 2118 2119 //-------------------------------------------------------------------------- 2120 // 2121 // pltk_toplevel -- 2122 // 2123 // Create top level window without mapping it. 2124 // 2125 // Results: 2126 // Returns 1 on error. 2127 // 2128 // Side effects: 2129 // Returns window ID as *w. 2130 // 2131 //-------------------------------------------------------------------------- 2132 2133 static int 2134 pltk_toplevel( Tk_Window *PL_UNUSED( w ), Tcl_Interp *interp ) 2135 { 2136 static char wcmd[] = "wm withdraw ."; 2137 2138 // Create the main window without mapping it 2139 2140 if ( Tk_Init( interp ) ) 2141 { 2142 fprintf( stderr, "tk_init:%s\n", Tcl_GetStringResult( interp ) ); 2143 return 1; 2144 } 2145 2146 Tcl_VarEval( interp, wcmd, (char *) NULL ); 2147 2148 return 0; 2149 } 2150 2151 //-------------------------------------------------------------------------- 2152 // tk_wait() 2153 // 2154 // Waits for the specified expression to evaluate to true before 2155 // proceeding. While we are waiting to proceed, all events (for this 2156 // or other interpreters) are handled. 2157 // 2158 // Use a static string buffer to hold the command, to ensure it's in 2159 // writable memory (grrr...). 2160 //-------------------------------------------------------------------------- 2161 2162 static void 2163 tk_wait( PLStream *pls, const char *cmd ) 2164 { 2165 TkDev *dev = (TkDev *) pls->dev; 2166 int result = 0; 2167 2168 dbug_enter( "tk_wait" ); 2169 2170 copybuf( pls, cmd ); 2171 for (;; ) 2172 { 2173 if ( Tcl_ExprBoolean( dev->interp, dev->cmdbuf, &result ) ) 2174 { 2175 fprintf( stderr, "tk_wait command \"%s\" failed:\n\t %s\n", 2176 cmd, Tcl_GetStringResult( dev->interp ) ); 2177 break; 2178 } 2179 if ( result ) 2180 break; 2181 2182 Tk_DoOneEvent( 0 ); 2183 } 2184 } 2185 2186 //-------------------------------------------------------------------------- 2187 // server_cmd 2188 // 2189 // Sends specified command to server, aborting on an error. 2190 // If nowait is set, the command is issued in the background. 2191 // 2192 // If commands MUST proceed in a certain order (e.g. initialization), it 2193 // is safest to NOT run them in the background. 2194 // 2195 // In order to protect args that have embedded spaces in them, I enclose 2196 // the entire command in a [list ...], but for TK sends ONLY. If done with 2197 // Tcl-DP RPC, the sent command is no longer recognized. Evidently an 2198 // extra scan of the line is done with TK sends for some reason. 2199 //-------------------------------------------------------------------------- 2200 2201 static void 2202 server_cmd( PLStream *pls, const char *cmd, int nowait ) 2203 { 2204 TkDev *dev = (TkDev *) pls->dev; 2205 static char dpsend_cmd0[] = "dp_RPC $server "; 2206 static char dpsend_cmd1[] = "dp_RDO $server "; 2207 static char tksend_cmd0[] = "send $server "; 2208 static char tksend_cmd1[] = "send $server after 1 "; 2209 int result; 2210 2211 dbug_enter( "server_cmd" ); 2212 pldebug( "server_cmd", "Sending command: %s\n", cmd ); 2213 2214 if ( pls->dp ) 2215 { 2216 if ( nowait ) 2217 result = Tcl_VarEval( dev->interp, dpsend_cmd1, cmd, 2218 (char **) NULL ); 2219 else 2220 result = Tcl_VarEval( dev->interp, dpsend_cmd0, cmd, 2221 (char **) NULL ); 2222 } 2223 else 2224 { 2225 if ( nowait ) 2226 result = Tcl_VarEval( dev->interp, tksend_cmd1, "[list ", 2227 cmd, "]", (char **) NULL ); 2228 else 2229 result = Tcl_VarEval( dev->interp, tksend_cmd0, "[list ", 2230 cmd, "]", (char **) NULL ); 2231 } 2232 2233 if ( result != TCL_OK ) 2234 { 2235 fprintf( stderr, "Server command \"%s\" failed:\n\t %s\n", 2236 cmd, Tcl_GetStringResult( dev->interp ) ); 2237 abort_session( pls, "" ); 2238 } 2239 } 2240 2241 //-------------------------------------------------------------------------- 2242 // tcl_cmd 2243 // 2244 // Evals the specified command, aborting on an error. 2245 //-------------------------------------------------------------------------- 2246 2247 static void 2248 tcl_cmd( PLStream *pls, const char *cmd ) 2249 { 2250 TkDev *dev = (TkDev *) pls->dev; 2251 2252 dbug_enter( "tcl_cmd" ); 2253 2254 pldebug( "tcl_cmd", "Evaluating command: %s\n", cmd ); 2255 if ( Tcl_VarEval( dev->interp, cmd, (char **) NULL ) != TCL_OK ) 2256 { 2257 fprintf( stderr, "TCL command \"%s\" failed:\n\t %s\n", 2258 cmd, Tcl_GetStringResult( dev->interp ) ); 2259 abort_session( pls, "" ); 2260 } 2261 } 2262 2263 //-------------------------------------------------------------------------- 2264 // copybuf 2265 // 2266 // Puts command in a static string buffer, to ensure it's in writable 2267 // memory (grrr...). 2268 //-------------------------------------------------------------------------- 2269 2270 static void 2271 copybuf( PLStream *pls, const char *cmd ) 2272 { 2273 TkDev *dev = (TkDev *) pls->dev; 2274 2275 if ( dev->cmdbuf == NULL ) 2276 { 2277 dev->cmdbuf_len = 100; 2278 dev->cmdbuf = (char *) malloc( dev->cmdbuf_len ); 2279 } 2280 2281 if ( strlen( cmd ) >= dev->cmdbuf_len ) 2282 { 2283 free( (void *) dev->cmdbuf ); 2284 dev->cmdbuf_len = strlen( cmd ) + 20; 2285 dev->cmdbuf = (char *) malloc( dev->cmdbuf_len ); 2286 } 2287 2288 strcpy( dev->cmdbuf, cmd ); 2289 } 2290 2291 //-------------------------------------------------------------------------- 2292 #else 2293 int 2294 pldummy_tk() 2295 { 2296 return 0; 2297 } 2298 2299 #endif // PLD_tk 2300