PLplot: tk.c Source File

PLplot 5.10.0

- Main Page
- Namespaces
- Classes
- Files

- File List
- File Members

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