47 #include <X11/keysym.h>
52 #include <sys/types.h>
54 # include <sys/wait.h>
75 #define PHYSICAL 0 // Enables physical scaling..
79 #define LOCATE_INVOKED_VIA_API 1
80 #define LOCATE_INVOKED_VIA_DRIVER 2
87 #define tk_wr( code ) \
88 if ( code ) { abort_session( pls, "Unable to write to PDFstrm" ); }
98 void plD_line_tk(
PLStream *,
short,
short,
short,
short );
110 static void tk_start(
PLStream *pls );
111 static void tk_stop(
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 );
124 static void set_windowname(
PLStream *pls );
128 static int pltkdriver_Init(
PLStream *pls );
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 );
136 static void copybuf(
PLStream *pls,
const char *
cmd );
137 static int pltk_toplevel( Tk_Window *w, Tcl_Interp *
interp );
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 );
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 ** );
153 static int LookupTkButtonEvent(
PLStream *pls, Tcl_Interp *
interp,
156 static char *drvoptcmd = NULL;
158 static DrvOpt tk_options[] = { {
"tcl_cmd",
DRV_STR, &drvoptcmd,
"Execute tcl command" },
159 { NULL,
DRV_INT, NULL, NULL } };
163 #ifndef ENABLE_DYNDRIVERS
203 fprintf( stderr,
"The Tcl-DP driver hasn't been installed!\n" );
258 if ( pls->
dev != NULL )
259 free( (
void *) pls->
dev );
261 pls->
dev = calloc( 1, (
size_t)
sizeof (
TkDev ) );
262 if ( pls->
dev == NULL )
263 plexit(
"plD_init_tk: Out of memory." );
268 if ( dev->
iodev == NULL )
269 plexit(
"plD_init_tk: Out of memory." );
308 tk_wr_header( pls,
"xmin" );
311 tk_wr_header( pls,
"xmax" );
314 tk_wr_header( pls,
"ymin" );
317 tk_wr_header( pls,
"ymax" );
320 tk_wr_header( pls,
"" );
338 plD_line_tk(
PLStream *pls,
short x1,
short y1,
short x2,
short y2 )
344 CheckForEvents( pls );
346 if ( x1 == dev->
xold && y1 == dev->
yold )
380 plD_polyline_tk(
PLStream *pls,
short *xa,
short *ya,
PLINT npts )
385 CheckForEvents( pls );
393 dev->
xold = xa[npts - 1];
394 dev->
yold = ya[npts - 1];
501 for ( i = 0; i < pls->
ncol0; i++ )
511 for ( i = 0; i < pls->
ncol1; i++ )
519 for ( i = 0; i < pls->
ncp1; i++ )
587 tk_XorMod( pls, (
PLINT *) ptr );
607 server_cmd( pls,
"$plwidget cmd plxormod 1 st", 1 );
609 server_cmd( pls,
"$plwidget cmd plxormod 0 st", 1 );
630 server_cmd( pls,
"$plwidget configure -xhairs on", 1 );
641 server_cmd( pls,
"$plwidget configure -xhairs off", 1 );
664 plabort(
"tk_di: Illegal call to driver (not yet initialized)" );
677 Tcl_SetVar( dev->
interp,
"rot", str, 0 );
679 server_cmd( pls,
"$plwidget cmd plsetopt -ori $rot", 1 );
688 Tcl_SetVar( dev->
interp,
"xl", str, 0 );
690 Tcl_SetVar( dev->
interp,
"yl", str, 0 );
692 Tcl_SetVar( dev->
interp,
"xr", str, 0 );
694 Tcl_SetVar( dev->
interp,
"yr", str, 0 );
696 server_cmd( pls,
"$plwidget cmd plsetopt -wplt $xl,$yl,$xr,$yr", 1 );
705 Tcl_SetVar( dev->
interp,
"mar", str, 0 );
707 Tcl_SetVar( dev->
interp,
"aspect", str, 0 );
709 Tcl_SetVar( dev->
interp,
"jx", str, 0 );
711 Tcl_SetVar( dev->
interp,
"jy", str, 0 );
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 );
722 server_cmd( pls,
"update", 1 );
723 server_cmd( pls,
"plw::update_view $plwindow", 1 );
764 dev->
interp = Tcl_CreateInterp();
766 if ( Tcl_Init( dev->
interp ) != TCL_OK )
768 fprintf( stderr,
"%s\n", Tcl_GetStringResult( dev->
interp ) );
769 abort_session( pls,
"Unable to initialize Tcl" );
772 tcl_cmd( pls,
"rename exec {}" );
776 set_windowname( pls );
779 Tcl_SetVar( dev->
interp,
"dp",
"1", TCL_GLOBAL_ONLY );
784 Tcl_SetVar( dev->
interp,
"dp",
"0", TCL_GLOBAL_ONLY );
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 );
793 Tcl_SetVar2( dev->
interp,
"env",
"DISPLAY",
"unix:0.0", TCL_GLOBAL_ONLY );
796 if ( pltk_toplevel( &dev->
w, dev->
interp ) )
797 abort_session( pls,
"Unable to create top-level window" );
802 if ( pltkdriver_Init( pls ) != TCL_OK )
804 abort_session( pls,
"" );
808 tcl_cmd( pls,
"global auto_path; puts \"auto_path: $auto_path\"" );
813 tcl_cmd( pls,
"plclient_init" );
828 tcl_cmd( pls,
"rename open {}" );
829 tcl_cmd( pls,
"rename rename {}" );
833 plwindow_init( pls );
864 tcl_cmd( pls,
"plclient_link_end" );
880 Tcl_DeleteInterp( dev->
interp );
886 if ( dev->
iodev != NULL )
891 free( (
void *) dev->
iodev );
905 abort_session(
PLStream *pls,
const char *msg )
945 if ( Tcl_Init(
interp ) == TCL_ERROR )
952 if ( Tdp_Init(
interp ) == TCL_ERROR )
965 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
971 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
975 Tcl_CreateCommand(
interp,
"abort", (Tcl_CmdProc *) Abort,
976 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
978 Tcl_CreateCommand(
interp,
"plfinfo", (Tcl_CmdProc *) Plfinfo,
979 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
981 Tcl_CreateCommand(
interp,
"keypress", (Tcl_CmdProc *) KeyEH,
982 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
984 Tcl_CreateCommand(
interp,
"buttonpress", (Tcl_CmdProc *) ButtonEH,
985 (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
990 tcl_cmd( pls,
"set client_name [winfo name .]" );
992 if ( pls->server_name != NULL )
993 Tcl_SetVar(
interp,
"server_name", pls->server_name, 0 );
995 if ( pls->server_host != NULL )
996 Tcl_SetVar(
interp,
"server_host", pls->server_host, 0 );
998 if ( pls->server_port != NULL )
999 Tcl_SetVar(
interp,
"server_port", pls->server_port, 0 );
1093 int server_exists = 0;
1097 pldebug(
"init_server",
"%s -- PID: %d, PGID: %d, PPID: %d\n",
1098 __FILE__, (
int) getpid(), (
int) getpgrp(), (
int) getppid() );
1108 if ( !server_exists )
1109 launch_server( pls );
1116 "set server [dp_MakeRPCClient $server_host $server_port]" );
1120 tcl_cmd( pls,
"set server $server_name" );
1125 if ( server_exists )
1126 tcl_cmd( pls,
"plclient_link_init" );
1139 const char *
argv[20];
1140 char *plserver_exec = NULL, *ptr;
1159 if ( pls->
user != NULL )
1172 argv[i++] =
"-child";
1175 argv[i++] =
"plserver_init";
1188 argv[i++] =
"-file";
1192 argv[i++] =
"/dev/null";
1203 argv[i++] =
"-name";
1206 if ( ( t = strchr( tmp,
'.' ) ) != NULL )
1211 argv[i++] =
"-name";
1217 argv[i++] =
"-auto_path";
1223 argv[i++] =
"-geometry";
1232 argv[i++] =
"-client_host";
1233 argv[i++] = Tcl_GetVar( dev->
interp,
"client_host", TCL_GLOBAL_ONLY );
1235 argv[i++] =
"-client_port";
1236 argv[i++] = Tcl_GetVar( dev->
interp,
"client_port", TCL_GLOBAL_ONLY );
1238 if ( pls->
user != NULL )
1246 argv[i++] =
"-client_name";
1247 argv[i++] = Tcl_GetVar( dev->
interp,
"client_name", TCL_GLOBAL_ONLY );
1255 argv[i++] =
"-display";
1260 argv[i++] =
"-display";
1261 if ( ( ptr = getenv(
"DISPLAY" ) ) != NULL )
1264 argv[i++] =
"unix:0.0";
1274 fprintf( stderr,
"argument list: \n " );
1275 for ( j = 0; j < i; j++ )
1276 fprintf( stderr,
"%s ",
argv[j] );
1277 fprintf( stderr,
"\n" );
1288 abort_session( pls,
"Unable to fork server process" );
1292 fprintf( stderr,
"Starting up %s on node %s\n", pls->
plserver,
1295 if ( execvp(
"rsh", (
char *
const *)
argv ) )
1297 perror(
"Unable to exec server process" );
1308 if ( ( plserver_exec == NULL ) || ( dev->
child_pid = fork() ) < 0 )
1310 abort_session( pls,
"Unable to fork server process" );
1319 sigemptyset( &set );
1320 sigaddset( &set, SIGINT );
1321 if ( sigprocmask( SIG_BLOCK, &set, 0 ) < 0 )
1322 fprintf( stderr,
"PLplot: sigprocmask failure\n" );
1325 pldebug(
"launch_server",
"Starting up %s\n", plserver_exec );
1326 if ( execv( plserver_exec, (
char *
const *)
argv ) )
1328 fprintf( stderr,
"Unable to exec server process.\n" );
1338 tk_wait( pls,
"[info exists client]" );
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++ )
1394 if ( ( tmp[i] ==
' ' ) || ( tmp[i] ==
'.' ) )
1397 if ( isupper( tmp[1] ) )
1398 tmp[1] = tolower( tmp[1] );
1399 Tcl_SetVar( dev->
interp,
"plwindow", tmp, 0 );
1405 "$plw_create_proc $plwindow [list $client]", 1 );
1407 tk_wait( pls,
"[info exists plwidget]" );
1415 bg = (
unsigned int) ( pls->
cmap0[0].
b | ( pls->
cmap0[0].
g << 8 ) | ( pls->
cmap0[0].
r << 16 ) );
1419 server_cmd( pls,
command, 0 );
1425 server_cmd( pls,
"$plwidget cmd plsetopt -nopixmap", 0 );
1430 server_cmd( pls,
"$plwidget cmd plsetopt -debug", 0 );
1435 server_cmd( pls,
"$plwidget cmd plsetopt -db", 0 );
1442 server_cmd( pls,
command, 0 );
1448 server_cmd( pls,
command, 0 );
1453 server_cmd( pls,
"$plw_start_proc $plwindow", 1 );
1454 tk_wait( pls,
"[info exists widget_is_ready]" );
1477 pname = strrchr( pls->
program,
'/' );
1485 maxlen = strlen( pname ) + 10;
1486 pls->
plwindow = (
char *) malloc( maxlen *
sizeof (
char ) );
1490 if ( pls->
ipls == 0 )
1498 for ( i = 0; i < (int) strlen( pls->
plwindow ); i++ )
1523 size_t bufmax = (size_t) ( pls->
bufmax * 1.2 );
1533 iodev->fileName = (
char *) tmpnam( NULL );
1534 if ( mkfifo( iodev->fileName,
1535 S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH ) < 0 )
1536 abort_session( pls,
"mkfifo error" );
1540 Tcl_SetVar( dev->
interp,
"fifoname", iodev->fileName, 0 );
1541 server_cmd( pls,
"$plwidget openlink fifo $fifoname", 1 );
1546 if ( ( iodev->fd = open( iodev->fileName, O_WRONLY ) ) == -1 )
1547 abort_session( pls,
"Error opening fifo for write" );
1552 iodev->typeName =
"fifo";
1553 iodev->file = fdopen( iodev->fd,
"wb" );
1558 if ( unlink( iodev->fileName ) == -1 )
1559 abort_session( pls,
"Error removing fifo" );
1567 iodev->typeName =
"socket";
1568 tcl_cmd( pls,
"plclient_dp_init" );
1569 iodev->fileHandle = Tcl_GetVar( dev->
interp,
"data_sock", 0 );
1571 if ( Tcl_GetOpenFile( dev->
interp, iodev->fileHandle,
1572 0, 1, ( ClientData ) & iodev->file ) != TCL_OK )
1574 fprintf( stderr,
"Cannot get file info:\n\t %s\n",
1575 Tcl_GetStringResult( dev->
interp ) );
1576 abort_session( pls,
"" );
1578 iodev->fd = fileno( iodev->file );
1625 HandleEvents( pls );
1667 HandleEvents( pls );
1674 pldebug(
"flush_output",
"%s: Flushing buffer, bytes = %ld\n",
1675 __FILE__, pdfs->bp );
1679 fprintf( stderr,
"Packet send failed:\n\t %s\n",
1680 Tcl_GetStringResult( dev->
interp ) );
1681 abort_session( pls,
"" );
1700 abort_session( pls,
"" );
1712 Plfinfo( ClientData clientData, Tcl_Interp *
interp,
int argc,
char **
argv )
1716 int result = TCL_OK;
1722 Tcl_AppendResult( interp,
"wrong # args: should be \"",
1723 " plfinfo wx wy\"", (
char *) NULL );
1728 dev->
width = (
unsigned int) atoi( argv[1] );
1729 dev->
height = (
unsigned int) atoi( argv[2] );
1749 KeyEH( ClientData clientData, Tcl_Interp *interp,
int argc,
char **argv )
1757 if ( ( result = LookupTkKeyEvent( pls, interp, argc, argv ) ) != TCL_OK )
1775 ButtonEH( ClientData clientData, Tcl_Interp *interp,
int argc,
char **argv )
1783 if ( ( result = LookupTkButtonEvent( pls, interp, argc, argv ) ) != TCL_OK )
1787 LocateButton( pls );
1789 ProcessButton( pls );
1816 LookupTkKeyEvent(
PLStream *pls, Tcl_Interp *interp,
int argc,
char **argv )
1826 Tcl_AppendResult( interp,
"wrong # args: should be \"",
1827 argv[0],
" key-value state pX pY dX dY key-name ?ascii-value?\"",
1832 gin->keysym = (
unsigned int) atol( argv[1] );
1833 gin->state = (
unsigned int) atol( argv[2] );
1834 gin->pX = atoi( argv[3] );
1835 gin->pY = atoi( argv[4] );
1836 gin->dX = atof( argv[5] );
1837 gin->dY = atof( argv[6] );
1841 gin->string[0] =
'\0';
1844 gin->string[0] = argv[8][0];
1845 gin->string[1] =
'\0';
1850 switch ( gin->keysym )
1858 gin->keysym &= 0xFF;
1862 pldebug(
"LookupTkKeyEvent",
1863 "KeyEH: stream: %d, Keyname %s, hex %x, ASCII: %s\n",
1864 (
int) pls->
ipls, keyname, (
unsigned int) gin->keysym, gin->string );
1885 LookupTkButtonEvent(
PLStream *pls, Tcl_Interp *interp,
int argc,
char **argv )
1894 Tcl_AppendResult( interp,
"wrong # args: should be \"",
1895 argv[0],
" button-number state pX pY dX dY\"", (
char *) NULL );
1899 gin->button = (
unsigned int) atol( argv[1] );
1900 gin->state = (
unsigned int) atol( argv[2] );
1901 gin->pX = atoi( argv[3] );
1902 gin->pY = atoi( argv[4] );
1903 gin->dX = atof( argv[5] );
1904 gin->dY = atof( argv[6] );
1907 pldebug(
"LookupTkButtonEvent",
1908 "button %d, state %d, pX: %d, pY: %d, dX: %f, dY: %f\n",
1909 gin->button, gin->state, gin->pX, gin->pY, gin->dX, gin->dY );
1931 if ( pls->
KeyEH != NULL )
1936 switch ( gin->keysym )
1954 server_cmd( pls,
"$plwidget configure -xhairs on", 1 );
1985 switch ( gin->button )
2013 server_cmd( pls,
"$plwidget configure -xhairs off", 1 );
2035 switch ( gin->button )
2097 if ( gin->keysym < 0xFF && isprint( gin->keysym ) )
2098 printf(
"%f %f %c\n", gin->wX, gin->wY, gin->keysym );
2100 printf(
"%f %f 0x%02x\n", gin->wX, gin->wY, gin->keysym );
2110 server_cmd( pls,
"$plwidget configure -xhairs off", 1 );
2130 pltk_toplevel( Tk_Window *
PL_UNUSED( w ), Tcl_Interp *interp )
2132 static char wcmd[] =
"wm withdraw .";
2136 if ( Tk_Init( interp ) )
2138 fprintf( stderr,
"tk_init:%s\n", Tcl_GetStringResult( interp ) );
2142 Tcl_VarEval( interp, wcmd, (
char *) NULL );
2166 copybuf( pls, cmd );
2169 if ( Tcl_ExprBoolean( dev->
interp, dev->
cmdbuf, &result ) )
2171 fprintf( stderr,
"tk_wait command \"%s\" failed:\n\t %s\n",
2172 cmd, Tcl_GetStringResult( dev->
interp ) );
2198 server_cmd(
PLStream *pls,
const char *cmd,
int nowait )
2201 static char dpsend_cmd0[] =
"dp_RPC $server ";
2202 static char dpsend_cmd1[] =
"dp_RDO $server ";
2203 static char tksend_cmd0[] =
"send $server ";
2204 static char tksend_cmd1[] =
"send $server after 1 ";
2208 pldebug(
"server_cmd",
"Sending command: %s\n", cmd );
2213 result = Tcl_VarEval( dev->
interp, dpsend_cmd1, cmd,
2216 result = Tcl_VarEval( dev->
interp, dpsend_cmd0, cmd,
2222 result = Tcl_VarEval( dev->
interp, tksend_cmd1,
"[list ",
2223 cmd,
"]", (
char **) NULL );
2225 result = Tcl_VarEval( dev->
interp, tksend_cmd0,
"[list ",
2226 cmd,
"]", (
char **) NULL );
2229 if ( result != TCL_OK )
2231 fprintf( stderr,
"Server command \"%s\" failed:\n\t %s\n",
2232 cmd, Tcl_GetStringResult( dev->
interp ) );
2233 abort_session( pls,
"" );
2250 pldebug(
"tcl_cmd",
"Evaluating command: %s\n", cmd );
2251 if ( Tcl_VarEval( dev->
interp, cmd, (
char **) NULL ) != TCL_OK )
2253 fprintf( stderr,
"TCL command \"%s\" failed:\n\t %s\n",
2254 cmd, Tcl_GetStringResult( dev->
interp ) );
2255 abort_session( pls,
"" );
2267 copybuf(
PLStream *pls,
const char *cmd )
2271 if ( dev->
cmdbuf == NULL )
2279 free( (
void *) dev->
cmdbuf );
2284 strcpy( dev->
cmdbuf, cmd );