37 PLDLLIMPEXP_DRIVER const char* plD_DEVICE_INFO_ntk =
"ntk:New tk driver:1:ntk:43:ntk\n";
43 void plD_line_ntk(
PLStream *,
short,
short,
short,
short );
53 #ifndef ENABLE_DYNDRIVERS
73 static PLFLT scale = 10.0;
76 static Tcl_Interp *
interp = NULL;
77 static Tk_Window mainw;
79 static char curcolor[80];
80 static char cmd[10000];
87 static short xold = -1, yold = -1;
89 static int curpts = 0;
92 static char rem_interp[80];
106 static char scmd[10000];
116 sprintf( scmd,
"send %s {%s}", rem_interp, cmd );
117 if ( Tcl_Eval(
interp, scmd ) != TCL_OK )
118 fprintf( stderr,
"%s\n",
interp->result );
128 sprintf( cmd,
"set ccanv %d; canvas $plf.f2.c$ccanv -width $xmax -height $ymax -background #%02x%02x%02x -xscrollcommand \"$hs set\" -yscrollcommand \"$vs set\" -scrollregion \"0 0 $xmax $ymax\"", ccanv, pls->
cmap0[0].
r, pls->
cmap0[0].
g, pls->
cmap0[0].
b );
132 sprintf( cmd,
"$plf.f1.mb.menu add command -label \"Page $ccanv\" -command {\n"
133 "set w $plf.f2.c%d;\n"
134 "$hs configure -command \"$w xview\";\n"
135 "$vs configure -command \"$w yview\";\n"
136 "set dname \"Page %d\";\n"
137 "pack forget $ocanvas;\n"
138 "set ocanvas $plf.f2.c%d;\n"
139 "pack $ocanvas -fill both -expand 1;\n"
140 "scan [$w xview] \"%%f %%f\" i j;\n"
142 "scan [$w yview] \"%%f %%f\" i j;\n"
144 ccanv, ccanv, ccanv );
147 sprintf( cmd,
"set item(%d) 0", ccanv );
153 sprintf( cmd,
"bind $plf.f2.c$ccanv <Shift-Button-1> {\n"
155 "incr item($cc); set tt $item($cc);\n"
158 "pack $hs -side bottom -fill x;\n"
159 "pack $vs -side right -fill y;\n"
160 "pack forget %%W; pack %%W -fill both -expand 1}\n"
161 "set zx($cc,$tt) %%x;\n"
162 "set zy($cc,$tt) %%y;\n"
163 "%%W scale all %%x %%y 1.6 1.6;\n"
164 "%%W configure -scrollregion [%%W bbox all];\n"
170 sprintf( cmd,
"bind $plf.f2.c$ccanv <Shift-Button-3> {\n"
171 "set cc %d; set tt $item($cc);\n"
173 "%%W scale all $zx($cc,$tt) $zy($cc,$tt) 0.625 0.625\n"
174 "%%W configure -scrollregion [%%W bbox all];\n"
175 "set item($cc) [expr $tt - 1]}\n"
176 "if { $item($cc) == 0} {\n"
177 "set scroll_use [expr $scroll_use - 1];\n"
178 "if {$scroll_use == 0} {\n"
179 "pack forget $plf.f2.hscroll $plf.f2.vscroll}\n"
180 "%%W configure -scrollregion \"0 0 $xmax $ymax\"}}", ccanv );
184 sprintf( cmd,
"bind $plf.f2.c$ccanv <Shift-Button-2> {\n"
185 "set cc %d; set tt $item($cc); \n"
186 "while {$tt != 0} {\n"
187 "%%W scale all $zx($cc,$tt) $zy($cc,$tt) 0.625 0.625\n"
188 "set tt [expr $tt - 1]};\n"
190 "%%W configure -scrollregion \"0 0 $xmax $ymax\";\n"
191 "set scroll_use [expr $scroll_use - 1];\n"
192 "if {$scroll_use == 0} {\n"
193 "pack forget $plf.f2.hscroll $plf.f2.vscroll}}", ccanv );
197 sprintf( cmd,
"bind $plf.f2.c$ccanv <Control-Button-1> \"$plf.f2.c%d scan mark %%x %%y\"", ccanv );
200 sprintf( cmd,
"bind $plf.f2.c$ccanv <Control-Button1-Motion> \"$plf.f2.c%d scan dragto %%x %%y\"", ccanv );
204 tk_cmd(
"bind $plf.f2.c$ccanv <Control-Button-2> {\n"
205 "set xx [ expr [winfo pointerx .] - [winfo rootx %W]];\n"
206 "set yy [ expr [winfo pointery .] - [winfo rooty %W]];\n"
207 "set near [%W find closest $xx $yy];\n"
208 "%W move $near 20 20;\n"
209 "after 500 \"%W move $near -20 -20\"}" );
212 sprintf( cmd,
"$plf.f1.mb.menu invoke %d", ccanv - 1 );
231 strcpy( curcolor,
"black" );
245 strcpy( base,
".plf" );
247 interp = Tcl_CreateInterp();
249 if ( Tcl_Init(
interp ) != TCL_OK )
250 plexit(
"Unable to initialize Tcl." );
253 plexit(
"Unable to initialize Tk." );
255 mainw = Tk_MainWindow(
interp );
256 Tcl_Eval(
interp,
"rename exec {}" );
258 Tcl_Eval(
interp,
"tk appname PLplot_ntk" );
262 Tcl_Eval(
interp,
"wm withdraw ." );
264 sprintf( cmd,
"send %s \"set client [tk appname]; wm deiconify .\"", rem_interp );
265 if ( Tcl_Eval(
interp, cmd ) != TCL_OK )
267 fprintf( stderr,
"%s\n",
interp->result );
268 plexit(
"No such tk server." );
272 sprintf( cmd,
"set scroll_use 0; set plf %s; set vs $plf.f2.vscroll; set hs $plf.f2.hscroll; set xmax %d; set ymax %d; set ocanvas .;", base,
xmax,
ymax );
275 tk_cmd(
"catch \"frame $plf\"; pack $plf -fill both -expand 1" );
277 sprintf( cmd,
"frame $plf.f1;\n"
278 "frame $plf.f2 -width %d -height %d;\n"
279 "pack $plf.f1 -fill x;\n"
280 "pack $plf.f2 -fill both -expand 1",
xmax,
ymax );
283 tk_cmd(
"scrollbar $plf.f2.hscroll -orient horiz;\n"
284 "scrollbar $plf.f2.vscroll" );
286 tk_cmd(
"menubutton $plf.f1.mb -text \"Page 1\" -textvariable dname -relief raised -indicatoron 1 -menu $plf.f1.mb.menu;\n"
287 "menu $plf.f1.mb.menu -tearoff 0;\n"
288 "pack $plf.f1.mb -side left" );
291 tk_cmd(
"button $plf.f1.quit -text Quit -command exit;\n"
292 "pack $plf.f1.quit -side right" );
294 tk_cmd(
"button $plf.f1.quit -text Quit -command {send -async $client exit;\n"
297 "pack $plf.f1.quit -side right" );
303 Tcl_Eval(
interp,
"tk scaling" );
304 ppm = (
PLFLT) atof(
interp->result ) / ( 25.4 / 72. );
314 plD_polyline_ntk( pls, xb, yb, curpts );
316 xold = yold = -1; curpts = 0;
321 plD_line_ntk(
PLStream *pls,
short x1a,
short y1a,
short x2a,
short y2a )
323 if ( xold == x1a && yold == y1a )
325 xold = xb[curpts] = x2a; yold = yb[curpts] = y2a; curpts++;
330 xb[curpts] = x1a; yb[curpts] = y1a; curpts++;
331 xold = xb[curpts] = x2a; yold = yb[curpts] = y2a; curpts++;
334 if ( curpts == NPTS )
336 fprintf( stderr,
"\nflush: %d ", curpts );
342 plD_polyline_ntk(
PLStream *pls,
short *xa,
short *ya,
PLINT npts )
347 j = sprintf( cmd,
"$plf.f2.c%d create line ", ccanv );
348 for ( i = 0; i < npts; i++ )
349 j += sprintf( &cmd[j],
"%.1f %.1f ", xa[i] / scale,
ymax - ya[i] / scale );
351 j += sprintf( &cmd[j],
" -fill %s", curcolor );
352 if ( dash[0] ==
'-' )
353 j += sprintf( &cmd[j],
" %s", dash );
366 tk_cmd(
"bind . <KeyPress> {set keypress %N}" );
373 tk_cmd(
"info exists keypress" );
374 sscanf(
interp->result,
"%d", &st );
377 tk_cmd(
"set keypress" );
378 sscanf(
interp->result,
"%d", &key );
380 tk_cmd(
"unset keypress" );
384 tk_cmd(
"bind . <Key> {};" );
397 create_canvas( pls );
406 tk_cmd(
"destroy $plf; wm withdraw ." );
417 sprintf( curcolor,
"#%02x%02x%02x",
435 tk_cmd(
"winfo exists $plf.f2.c$ccanv" );
436 sscanf(
interp->result,
"%d", &st );
440 tk_cmd(
"set ocursor [lindex [$plf.f2.c$ccanv configure -cursor] 4]" );
443 tk_cmd(
"$plf.f2.c$ccanv configure -cursor cross;\n"
444 "bind $plf.f2.c$ccanv <Button> {set xloc %x; set yloc %y; set bloc %b; set sloc %s};\n"
445 "bind $plf.f2.c$ccanv <B1-Motion> {set xloc %x; set yloc %y; set bloc %b; set sloc %s};\n"
446 "bind $plf.f2.c$ccanv <B2-Motion> {set xloc %x; set yloc %y; set bloc %b; set sloc %s};\n"
447 "bind $plf.f2.c$ccanv <B3-Motion> {set xloc %x; set yloc %y; set bloc %b; set sloc %s};" );
452 tk_cmd(
"info exists xloc" );
453 sscanf(
interp->result,
"%d", &st );
455 tk_cmd(
"set xloc" );
456 sscanf(
interp->result,
"%d", &gin.
pX );
457 tk_cmd(
"set yloc" );
458 sscanf(
interp->result,
"%d", &gin.
pY );
459 tk_cmd(
"set bloc" );
461 tk_cmd(
"set sloc" );
467 tk_cmd(
"bind $plf.f2.c$ccanv <ButtonPress> {};\n"
468 "bind $plf.f2.c$ccanv <ButtonMotion> {};\n"
469 "bind $plf.f2.c$ccanv <B2-Motion> {};\n"
470 "bind $plf.f2.c$ccanv <B3-Motion> {};\n"
474 tk_cmd(
"$plf.f2.c$ccanv configure -cursor {}" );
485 static unsigned char bit_pat[] = {
486 0x24, 0x01, 0x92, 0x00, 0x49, 0x00, 0x24, 0x00, 0x12, 0x00, 0x09, 0x00,
487 0x04, 0x00, 0x02, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
488 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff
494 xa = (
short *) malloc(
sizeof (
short ) * pls->
dev_npts );
495 ya = (
short *) malloc(
sizeof (
short ) * pls->
dev_npts );
496 for ( i = 0; i < pls->
dev_npts; i++ )
498 xa[i] = pls->
dev_x[i];
499 ya[i] = pls->
dev_y[i];
502 j = sprintf( dash,
"-dash {" );
503 for ( i = 0; i < pls->
nms; i++ )
504 j += sprintf( &dash[j],
" %d %d",
505 (
int) ceil( pls->
mark[i] / 1e3 * ppm ),
506 (
int) ceil( pls->
space[i] / 1e3 * ppm ) );
507 sprintf( &dash[j],
"}" );
508 plD_polyline_ntk( pls, xa, ya, pls->
dev_npts );
509 free( xa ); free( ya );
522 if ( pls->
patt != 0 )
533 j = sprintf( cmd,
"$plf.f2.c%d create polygon ", ccanv );
534 for ( i = 0; i < pls->
dev_npts; i++ )
535 j += sprintf( &cmd[j],
"%.1f %.1f ", pls->
dev_x[i] / scale,
537 j += sprintf( &cmd[j],
" -fill %s", curcolor );
543 if ( pls->
patt != 0 )
545 Tk_DefineBitmap(
interp, Tk_GetUid(
"foo" ), bit_pat, 16, 16 );
546 bitmap = Tk_GetBitmap(
interp, mainw, Tk_GetUid(
"patt" ) );
548 j = sprintf( cmd,
"$plf.f2.c%d create polygon ", ccanv );
549 for ( i = 0; i < pls->
dev_npts; i++ )
550 j += sprintf( &cmd[j],
"%.1f %.1f ", pls->
dev_x[i] / scale,
552 j += sprintf( &cmd[j],
" -fill %s", curcolor );
553 if ( pls->
patt != 0 )
554 sprintf( &cmd[j],
" -stipple patt -outline black" );