45 #include <X11/keysym.h>
50 #include <sys/types.h>
52 # include <sys/wait.h>
73 #define PHYSICAL 0 // Enables physical scaling..
77 #define LOCATE_INVOKED_VIA_API 1
78 #define LOCATE_INVOKED_VIA_DRIVER 2
85 #define tk_wr( code ) \
86 if ( code ) { abort_session( pls, "Unable to write to PDFstrm" ); }
96 void plD_line_tk(
PLStream *,
short,
short,
short,
short );
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 );
134 static void copybuf(
PLStream *
pls,
const char *cmd );
135 static int pltk_toplevel( Tk_Window *w, Tcl_Interp *
interp );
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 ** );
154 static char *drvoptcmd = NULL;
156 static DrvOpt tk_options[] = { {
"tcl_cmd",
DRV_STR, &drvoptcmd,
"Execute tcl command" },
157 { NULL,
DRV_INT, NULL, NULL } };
161 #ifndef ENABLE_DYNDRIVERS
201 fprintf( stderr,
"The Tcl-DP driver hasn't been installed!\n" );
256 if ( pls->
dev != NULL )
257 free( (
void *) pls->
dev );
259 pls->
dev = calloc( 1, (
size_t)
sizeof (
TkDev ) );
260 if ( pls->
dev == NULL )
261 plexit(
"plD_init_tk: Out of memory." );
266 if ( dev->
iodev == NULL )
267 plexit(
"plD_init_tk: Out of memory." );
306 tk_wr_header( pls,
"xmin" );
309 tk_wr_header( pls,
"xmax" );
312 tk_wr_header( pls,
"ymin" );
315 tk_wr_header( pls,
"ymax" );
318 tk_wr_header( pls,
"" );
336 plD_line_tk(
PLStream *pls,
short x1,
short y1,
short x2,
short y2 )
342 CheckForEvents( pls );
344 if ( x1 == dev->
xold && y1 == dev->
yold )
378 plD_polyline_tk(
PLStream *pls,
short *xa,
short *ya,
PLINT npts )
383 CheckForEvents( pls );
391 dev->
xold = xa[npts - 1];
392 dev->
yold = ya[npts - 1];
499 for ( i = 0; i < pls->
ncol0; i++ )
509 for ( i = 0; i < pls->
ncol1; i++ )
517 for ( i = 0; i < pls->
ncp1; i++ )
585 tk_XorMod( pls, (
PLINT *) ptr );
605 server_cmd( pls,
"$plwidget cmd plxormod 1 st", 1 );
607 server_cmd( pls,
"$plwidget cmd plxormod 0 st", 1 );
628 server_cmd( pls,
"$plwidget configure -xhairs on", 1 );
639 server_cmd( pls,
"$plwidget configure -xhairs off", 1 );
662 plabort(
"tk_di: Illegal call to driver (not yet initialized)" );
675 Tcl_SetVar( dev->
interp,
"rot", str, 0 );
677 server_cmd( pls,
"$plwidget cmd plsetopt -ori $rot", 1 );
686 Tcl_SetVar( dev->
interp,
"xl", str, 0 );
688 Tcl_SetVar( dev->
interp,
"yl", str, 0 );
690 Tcl_SetVar( dev->
interp,
"xr", str, 0 );
692 Tcl_SetVar( dev->
interp,
"yr", str, 0 );
694 server_cmd( pls,
"$plwidget cmd plsetopt -wplt $xl,$yl,$xr,$yr", 1 );
703 Tcl_SetVar( dev->
interp,
"mar", str, 0 );
705 Tcl_SetVar( dev->
interp,
"aspect", str, 0 );
707 Tcl_SetVar( dev->
interp,
"jx", str, 0 );
709 Tcl_SetVar( dev->
interp,
"jy", str, 0 );
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 );
720 server_cmd( pls,
"update", 1 );
721 server_cmd( pls,
"plw::update_view $plwindow", 1 );
762 dev->
interp = Tcl_CreateInterp();
764 if ( Tcl_Init( dev->
interp ) != TCL_OK )
766 fprintf( stderr,
"%s\n", Tcl_GetStringResult( dev->
interp ) );
767 abort_session( pls,
"Unable to initialize Tcl" );
770 tcl_cmd( pls,
"rename exec {}" );
774 set_windowname( pls );
777 Tcl_SetVar( dev->
interp,
"dp",
"1", TCL_GLOBAL_ONLY );
782 Tcl_SetVar( dev->
interp,
"dp",
"0", TCL_GLOBAL_ONLY );
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 );
791 Tcl_SetVar2( dev->
interp,
"env",
"DISPLAY",
"unix:0.0", TCL_GLOBAL_ONLY );
794 if ( pltk_toplevel( &dev->
w, dev->
interp ) )
795 abort_session( pls,
"Unable to create top-level window" );
800 if ( pltkdriver_Init( pls ) != TCL_OK )
802 abort_session( pls,
"" );
806 tcl_cmd( pls,
"global auto_path; puts \"auto_path: $auto_path\"" );
811 tcl_cmd( pls,
"plclient_init" );
826 tcl_cmd( pls,
"rename open {}" );
827 tcl_cmd( pls,
"rename rename {}" );
831 plwindow_init( pls );
862 tcl_cmd( pls,
"plclient_link_end" );
878 Tcl_DeleteInterp( dev->
interp );
884 if ( dev->
iodev != NULL )
889 free( (
void *) dev->
iodev );
903 abort_session(
PLStream *pls,
const char *msg )
943 if ( Tcl_Init(
interp ) == TCL_ERROR )
950 if ( Tdp_Init(
interp ) == TCL_ERROR )
963 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
969 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
973 Tcl_CreateCommand(
interp,
"abort", (Tcl_CmdProc *) Abort,
974 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
976 Tcl_CreateCommand(
interp,
"plfinfo", (Tcl_CmdProc *) Plfinfo,
977 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
979 Tcl_CreateCommand(
interp,
"keypress", (Tcl_CmdProc *) KeyEH,
980 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
982 Tcl_CreateCommand(
interp,
"buttonpress", (Tcl_CmdProc *) ButtonEH,
983 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
988 tcl_cmd( pls,
"set client_name [winfo name .]" );
990 if ( pls->server_name != NULL )
991 Tcl_SetVar(
interp,
"server_name", pls->server_name, 0 );
993 if ( pls->server_host != NULL )
994 Tcl_SetVar(
interp,
"server_host", pls->server_host, 0 );
996 if ( pls->server_port != NULL )
997 Tcl_SetVar(
interp,
"server_port", pls->server_port, 0 );
1091 int server_exists = 0;
1095 pldebug(
"init_server",
"%s -- PID: %d, PGID: %d, PPID: %d\n",
1096 __FILE__, (
int) getpid(), (
int) getpgrp(), (
int) getppid() );
1106 if ( !server_exists )
1107 launch_server( pls );
1114 "set server [dp_MakeRPCClient $server_host $server_port]" );
1118 tcl_cmd( pls,
"set server $server_name" );
1123 if ( server_exists )
1124 tcl_cmd( pls,
"plclient_link_init" );
1137 const char *
argv[20];
1138 char *plserver_exec = NULL, *ptr;
1157 if ( pls->
user != NULL )
1170 argv[i++] =
"-child";
1173 argv[i++] =
"plserver_init";
1186 argv[i++] =
"-file";
1190 argv[i++] =
"/dev/null";
1201 argv[i++] =
"-name";
1204 if ( ( t = strchr( tmp,
'.' ) ) != NULL )
1209 argv[i++] =
"-name";
1215 argv[i++] =
"-auto_path";
1221 argv[i++] =
"-geometry";
1230 argv[i++] =
"-client_host";
1231 argv[i++] = Tcl_GetVar( dev->
interp,
"client_host", TCL_GLOBAL_ONLY );
1233 argv[i++] =
"-client_port";
1234 argv[i++] = Tcl_GetVar( dev->
interp,
"client_port", TCL_GLOBAL_ONLY );
1236 if ( pls->
user != NULL )
1244 argv[i++] =
"-client_name";
1245 argv[i++] = Tcl_GetVar( dev->
interp,
"client_name", TCL_GLOBAL_ONLY );
1253 argv[i++] =
"-display";
1258 argv[i++] =
"-display";
1259 if ( ( ptr = getenv(
"DISPLAY" ) ) != NULL )
1262 argv[i++] =
"unix:0.0";
1272 fprintf( stderr,
"argument list: \n " );
1273 for ( j = 0; j < i; j++ )
1274 fprintf( stderr,
"%s ",
argv[j] );
1275 fprintf( stderr,
"\n" );
1286 abort_session( pls,
"Unable to fork server process" );
1290 fprintf( stderr,
"Starting up %s on node %s\n", pls->
plserver,
1293 if ( execvp(
"rsh", (
char *
const *)
argv ) )
1295 perror(
"Unable to exec server process" );
1306 if ( ( plserver_exec == NULL ) || ( dev->
child_pid = fork() ) < 0 )
1308 abort_session( pls,
"Unable to fork server process" );
1317 sigemptyset( &set );
1318 sigaddset( &set, SIGINT );
1319 if ( sigprocmask( SIG_BLOCK, &set, 0 ) < 0 )
1320 fprintf( stderr,
"PLplot: sigprocmask failure\n" );
1323 pldebug(
"launch_server",
"Starting up %s\n", plserver_exec );
1324 if ( execv( plserver_exec, (
char *
const *)
argv ) )
1326 fprintf( stderr,
"Unable to exec server process.\n" );
1336 tk_wait( pls,
"[info exists client]" );
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++ )
1392 if ( ( tmp[i] ==
' ' ) || ( tmp[i] ==
'.' ) )
1395 if ( isupper( tmp[1] ) )
1396 tmp[1] = tolower( tmp[1] );
1397 Tcl_SetVar( dev->
interp,
"plwindow", tmp, 0 );
1403 "$plw_create_proc $plwindow [list $client]", 1 );
1405 tk_wait( pls,
"[info exists plwidget]" );
1413 bg = (
unsigned int) ( pls->
cmap0[0].
b | ( pls->
cmap0[0].
g << 8 ) | ( pls->
cmap0[0].
r << 16 ) );
1417 server_cmd( pls,
command, 0 );
1423 server_cmd( pls,
"$plwidget cmd plsetopt -nopixmap", 0 );
1428 server_cmd( pls,
"$plwidget cmd plsetopt -debug", 0 );
1433 server_cmd( pls,
"$plwidget cmd plsetopt -db", 0 );
1440 server_cmd( pls,
command, 0 );
1446 server_cmd( pls,
command, 0 );
1451 server_cmd( pls,
"$plw_start_proc $plwindow", 1 );
1452 tk_wait( pls,
"[info exists widget_is_ready]" );
1475 pname = strrchr( pls->
program,
'/' );
1483 maxlen = strlen( pname ) + 10;
1484 pls->
plwindow = (
char *) malloc( maxlen *
sizeof (
char ) );
1488 if ( pls->
ipls == 0 )
1496 for ( i = 0; i < (int) strlen( pls->
plwindow ); i++ )
1521 size_t bufmax = (size_t) ( pls->
bufmax * 1.2 );
1522 const char *dirname = NULL;
1534 if ( dirname == NULL || iodev->fileName == NULL )
1535 abort_session( pls,
"mkfifo error" );
1539 Tcl_SetVar( dev->
interp,
"fifoname", iodev->fileName, 0 );
1540 server_cmd( pls,
"$plwidget openlink fifo $fifoname", 1 );
1545 if ( ( iodev->fd = open( iodev->fileName, O_WRONLY ) ) == -1 )
1546 abort_session( pls,
"Error opening fifo for write" );
1551 iodev->typeName =
"fifo";
1552 iodev->file = fdopen( iodev->fd,
"wb" );
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 );
1571 iodev->typeName =
"socket";
1572 tcl_cmd( pls,
"plclient_dp_init" );
1573 iodev->fileHandle = Tcl_GetVar( dev->
interp,
"data_sock", 0 );
1575 if ( Tcl_GetOpenFile( dev->
interp, iodev->fileHandle,
1576 0, 1, ( ClientData ) & iodev->file ) != TCL_OK )
1578 fprintf( stderr,
"Cannot get file info:\n\t %s\n",
1579 Tcl_GetStringResult( dev->
interp ) );
1580 abort_session( pls,
"" );
1582 iodev->fd = fileno( iodev->file );
1629 HandleEvents( pls );
1671 HandleEvents( pls );
1678 pldebug(
"flush_output",
"%s: Flushing buffer, bytes = %ld\n",
1679 __FILE__, pdfs->bp );
1683 fprintf( stderr,
"Packet send failed:\n\t %s\n",
1684 Tcl_GetStringResult( dev->
interp ) );
1685 abort_session( pls,
"" );
1704 abort_session( pls,
"" );
1716 Plfinfo( ClientData clientData, Tcl_Interp *
interp,
int argc,
char **
argv )
1720 int result = TCL_OK;
1726 Tcl_AppendResult( interp,
"wrong # args: should be \"",
1727 " plfinfo wx wy\"", (
char *) NULL );
1732 dev->
width = (
unsigned int) atoi( argv[1] );
1733 dev->
height = (
unsigned int) atoi( argv[2] );
1753 KeyEH( ClientData clientData, Tcl_Interp *interp,
int argc,
char **argv )
1761 if ( ( result = LookupTkKeyEvent( pls, interp, argc, argv ) ) != TCL_OK )
1779 ButtonEH( ClientData clientData, Tcl_Interp *interp,
int argc,
char **argv )
1787 if ( ( result = LookupTkButtonEvent( pls, interp, argc, argv ) ) != TCL_OK )
1791 LocateButton( pls );
1793 ProcessButton( pls );
1820 LookupTkKeyEvent(
PLStream *pls, Tcl_Interp *interp,
int argc,
char **argv )
1830 Tcl_AppendResult( interp,
"wrong # args: should be \"",
1831 argv[0],
" key-value state pX pY dX dY key-name ?ascii-value?\"",
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] );
1845 gin->string[0] =
'\0';
1848 gin->string[0] = argv[8][0];
1849 gin->string[1] =
'\0';
1854 switch ( gin->keysym )
1862 gin->keysym &= 0xFF;
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 );
1889 LookupTkButtonEvent(
PLStream *pls, Tcl_Interp *interp,
int argc,
char **argv )
1898 Tcl_AppendResult( interp,
"wrong # args: should be \"",
1899 argv[0],
" button-number state pX pY dX dY\"", (
char *) NULL );
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] );
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 );
1935 if ( pls->
KeyEH != NULL )
1940 switch ( gin->keysym )
1958 server_cmd( pls,
"$plwidget configure -xhairs on", 1 );
1989 switch ( gin->button )
2017 server_cmd( pls,
"$plwidget configure -xhairs off", 1 );
2039 switch ( gin->button )
2098 if ( dev->
locate_mode == LOCATE_INVOKED_VIA_DRIVER )
2101 if ( gin->keysym < 0xFF && isprint( gin->keysym ) )
2102 printf(
"%f %f %c\n", gin->wX, gin->wY, gin->keysym );
2104 printf(
"%f %f 0x%02x\n", gin->wX, gin->wY, gin->keysym );
2114 server_cmd( pls,
"$plwidget configure -xhairs off", 1 );
2134 pltk_toplevel( Tk_Window *
PL_UNUSED( w ), Tcl_Interp *interp )
2136 static char wcmd[] =
"wm withdraw .";
2140 if ( Tk_Init( interp ) )
2142 fprintf( stderr,
"tk_init:%s\n", Tcl_GetStringResult( interp ) );
2146 Tcl_VarEval( interp, wcmd, (
char *) NULL );
2163 tk_wait(
PLStream *pls,
const char *cmd )
2170 copybuf( pls, cmd );
2173 if ( Tcl_ExprBoolean( dev->
interp, dev->
cmdbuf, &result ) )
2175 fprintf( stderr,
"tk_wait command \"%s\" failed:\n\t %s\n",
2176 cmd, Tcl_GetStringResult( dev->
interp ) );
2202 server_cmd(
PLStream *pls,
const char *cmd,
int nowait )
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 ";
2212 pldebug(
"server_cmd",
"Sending command: %s\n", cmd );
2217 result = Tcl_VarEval( dev->
interp, dpsend_cmd1, cmd,
2220 result = Tcl_VarEval( dev->
interp, dpsend_cmd0, cmd,
2226 result = Tcl_VarEval( dev->
interp, tksend_cmd1,
"[list ",
2227 cmd,
"]", (
char **) NULL );
2229 result = Tcl_VarEval( dev->
interp, tksend_cmd0,
"[list ",
2230 cmd,
"]", (
char **) NULL );
2233 if ( result != TCL_OK )
2235 fprintf( stderr,
"Server command \"%s\" failed:\n\t %s\n",
2236 cmd, Tcl_GetStringResult( dev->
interp ) );
2237 abort_session( pls,
"" );
2254 pldebug(
"tcl_cmd",
"Evaluating command: %s\n", cmd );
2255 if ( Tcl_VarEval( dev->
interp, cmd, (
char **) NULL ) != TCL_OK )
2257 fprintf( stderr,
"TCL command \"%s\" failed:\n\t %s\n",
2258 cmd, Tcl_GetStringResult( dev->
interp ) );
2259 abort_session( pls,
"" );
2271 copybuf(
PLStream *pls,
const char *cmd )
2275 if ( dev->
cmdbuf == NULL )
2283 free( (
void *) dev->
cmdbuf );
2288 strcpy( dev->
cmdbuf, cmd );
int plParseDrvOpts(DrvOpt *acc_opt)
PLControlPt cmap1cp[PL_MAX_CMAP1CP]
void(* plD_line_fp)(struct PLStream_struct *, short, short, short, short)
void plexit(PLCHAR_VECTOR errormsg)
void(* ButtonEH)(PLGraphicsIn *gin, void *ButtonEH_data, int *exit_eventloop)
void(* plD_eop_fp)(struct PLStream_struct *)
PDFstrm * pdf_bopen(U_CHAR *buffer, size_t bufmax)
void(* plD_state_fp)(struct PLStream_struct *, PLINT)
void(* plD_tidy_fp)(struct PLStream_struct *)
int pdf_wr_header(PDFstrm *pdfs, PLCHAR_VECTOR header)
int pdf_wr_2bytes(PDFstrm *pdfs, U_SHORT s)
void plCloseFile(PLStream *pls)
int pdf_wr_2nbytes(PDFstrm *pdfs, U_SHORT *s, PLINT n)
void plGinInit(PLGraphicsIn *gin)
void(* LocateEH)(PLGraphicsIn *gin, void *LocateEH_data, int *locate_mode)
PLINT plTranslateCursor(PLGraphicsIn *plg)
PLDLLIMPEXP_TCLTK int pls_auto_path(Tcl_Interp *interp)
PLDLLIMPEXP_DRIVER void plD_dispatch_init_tk(PLDispatchTable *pdt)
void plabort(PLCHAR_VECTOR errormsg)
void(* plD_polyline_fp)(struct PLStream_struct *, short *, short *, PLINT)
void(* plD_esc_fp)(struct PLStream_struct *, PLINT, void *)
static int tcl_cmd(Tcl_Interp *interp, const char *cmd)
void(* plD_bop_fp)(struct PLStream_struct *)
char * pl_create_tempfifo(const char **p_fifoname, const char **p_dirname)
PLDLLIMPEXP_TCLTK int plWait_Until(ClientData, Tcl_Interp *, int, const char **)
char * plFindCommand(PLCHAR_VECTOR fn)
void plP_setpxl(PLFLT xpmm, PLFLT ypmm)
#define PLDLLIMPEXP_DRIVER
static PLStream * pls[PL_NSTREAMS]
void plP_setphy(PLINT xmin, PLINT xmax, PLINT ymin, PLINT ymax)
int pdf_wr_ieeef(PDFstrm *pdfs, float f)
char PLDLLIMPEXP * plstrdup(PLCHAR_VECTOR src)
int pdf_close(PDFstrm *pdfs)
static Tcl_DString command
void(* KeyEH)(PLGraphicsIn *gin, void *KeyEH_data, int *exit_eventloop)
int plHost_ID(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv)
static Tcl_Interp * interp
PLDLLIMPEXP_TCLTK int pl_PacketSend(Tcl_Interp *interp, PLiodev *iodev, PDFstrm *pdfs)
plD_polyline_fp pl_polyline
int pdf_wr_1byte(PDFstrm *pdfs, U_CHAR s)
void(* plD_init_fp)(struct PLStream_struct *)