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];
83 #define PLPLOT_NTK_CMD_SIZE 48000
84 static char cmd[PLPLOT_NTK_CMD_SIZE];
91 static short xold = -1, yold = -1;
93 static int curpts = 0;
96 static char rem_interp[80];
108 tk_cmd(
const char *gcmd )
110 static char scmd[PLPLOT_NTK_CMD_SIZE];
120 sprintf( scmd,
"send %s {%s}", rem_interp, gcmd );
121 if ( Tcl_Eval(
interp, scmd ) != TCL_OK )
122 fprintf( stderr,
"%s\n", Tcl_GetStringResult(
interp ) );
132 columnbreak = ( ccanv % 30 == 0 );
135 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 );
139 sprintf(
cmd,
"$plf.f1.mb.menu add command -label \"Page $ccanv\" -columnbreak %d -command {\n"
140 "set w $plf.f2.c%d;\n"
141 "$hs configure -command \"$w xview\";\n"
142 "$vs configure -command \"$w yview\";\n"
143 "set dname \"Page %d\";\n"
144 "pack forget $ocanvas;\n"
145 "set ocanvas $plf.f2.c%d;\n"
146 "pack $ocanvas -fill both -expand 1;\n"
147 "scan [$w xview] \"%%f %%f\" i j;\n"
149 "scan [$w yview] \"%%f %%f\" i j;\n"
151 columnbreak, ccanv, ccanv, ccanv );
154 sprintf(
cmd,
"set item(%d) 0", ccanv );
160 sprintf(
cmd,
"bind $plf.f2.c$ccanv <Shift-Button-1> {\n"
162 "incr item($cc); set tt $item($cc);\n"
165 "pack $hs -side bottom -fill x;\n"
166 "pack $vs -side right -fill y;\n"
167 "pack forget %%W; pack %%W -fill both -expand 1}\n"
168 "set zx($cc,$tt) %%x;\n"
169 "set zy($cc,$tt) %%y;\n"
170 "%%W scale all %%x %%y 1.6 1.6;\n"
171 "%%W configure -scrollregion [%%W bbox all];\n"
177 sprintf(
cmd,
"bind $plf.f2.c$ccanv <Shift-Button-3> {\n"
178 "set cc %d; set tt $item($cc);\n"
180 "%%W scale all $zx($cc,$tt) $zy($cc,$tt) 0.625 0.625\n"
181 "%%W configure -scrollregion [%%W bbox all];\n"
182 "set item($cc) [expr $tt - 1]}\n"
183 "if { $item($cc) == 0} {\n"
184 "set scroll_use [expr $scroll_use - 1];\n"
185 "if {$scroll_use == 0} {\n"
186 "pack forget $plf.f2.hscroll $plf.f2.vscroll}\n"
187 "%%W configure -scrollregion \"0 0 $xmax $ymax\"}}", ccanv );
191 sprintf(
cmd,
"bind $plf.f2.c$ccanv <Shift-Button-2> {\n"
192 "set cc %d; set tt $item($cc); \n"
193 "while {$tt != 0} {\n"
194 "%%W scale all $zx($cc,$tt) $zy($cc,$tt) 0.625 0.625\n"
195 "set tt [expr $tt - 1]};\n"
197 "%%W configure -scrollregion \"0 0 $xmax $ymax\";\n"
198 "set scroll_use [expr $scroll_use - 1];\n"
199 "if {$scroll_use == 0} {\n"
200 "pack forget $plf.f2.hscroll $plf.f2.vscroll}}", ccanv );
204 sprintf(
cmd,
"bind $plf.f2.c$ccanv <Control-Button-1> \"$plf.f2.c%d scan mark %%x %%y\"", ccanv );
207 sprintf(
cmd,
"bind $plf.f2.c$ccanv <Control-Button1-Motion> \"$plf.f2.c%d scan dragto %%x %%y\"", ccanv );
211 tk_cmd(
"bind $plf.f2.c$ccanv <Control-Button-2> {\n"
212 "set xx [ expr [winfo pointerx .] - [winfo rootx %W]];\n"
213 "set yy [ expr [winfo pointery .] - [winfo rooty %W]];\n"
214 "set near [%W find closest $xx $yy];\n"
215 "%W move $near 20 20;\n"
216 "after 500 \"%W move $near -20 -20\"}" );
219 sprintf(
cmd,
"$plf.f1.mb.menu invoke %d", ccanv - 1 );
238 strcpy( curcolor,
"black" );
252 strcpy( base,
".plf" );
254 interp = Tcl_CreateInterp();
256 if ( Tcl_Init(
interp ) != TCL_OK )
257 plexit(
"Unable to initialize Tcl." );
260 plexit(
"Unable to initialize Tk." );
262 mainw = Tk_MainWindow(
interp );
263 Tcl_Eval(
interp,
"rename exec {}" );
265 Tcl_Eval(
interp,
"tk appname PLplot_ntk" );
269 Tcl_Eval(
interp,
"wm withdraw ." );
271 sprintf(
cmd,
"send %s \"set client [tk appname]; wm deiconify .\"", rem_interp );
274 fprintf( stderr,
"%s\n", Tcl_GetStringResult(
interp ) );
275 plexit(
"No such tk server." );
279 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 );
282 tk_cmd(
"catch \"frame $plf\"; pack $plf -fill both -expand 1" );
284 sprintf(
cmd,
"frame $plf.f1;\n"
285 "frame $plf.f2 -width %d -height %d;\n"
286 "pack $plf.f1 -fill x;\n"
287 "pack $plf.f2 -fill both -expand 1",
xmax,
ymax );
290 tk_cmd(
"scrollbar $plf.f2.hscroll -orient horiz;\n"
291 "scrollbar $plf.f2.vscroll" );
293 tk_cmd(
"menubutton $plf.f1.mb -text \"Page 1\" -textvariable dname -relief raised -indicatoron 1 -menu $plf.f1.mb.menu;\n"
294 "menu $plf.f1.mb.menu -tearoff 0;\n"
295 "pack $plf.f1.mb -side left" );
298 tk_cmd(
"button $plf.f1.quit -text Quit -command exit;\n"
299 "pack $plf.f1.quit -side right" );
301 tk_cmd(
"button $plf.f1.quit -text Quit -command {send -async $client exit;\n"
304 "pack $plf.f1.quit -side right" );
310 Tcl_Eval(
interp,
"tk scaling" );
311 ppm = (
PLFLT) atof( Tcl_GetStringResult(
interp ) ) / ( 25.4 / 72. );
323 plD_polyline_ntk( pls, xb, yb, curpts );
325 xold = yold = -1; curpts = 0;
330 plD_line_ntk(
PLStream *pls,
short x1a,
short y1a,
short x2a,
short y2a )
332 if ( xold == x1a && yold == y1a )
334 xold = xb[curpts] = x2a; yold = yb[curpts] = y2a; curpts++;
339 xb[curpts] = x1a; yb[curpts] = y1a; curpts++;
340 xold = xb[curpts] = x2a; yold = yb[curpts] = y2a; curpts++;
343 if ( curpts == NPTS )
356 j = sprintf(
cmd,
"$plf.f2.c%d create line ", ccanv );
357 for ( i = 0; i < npts; i++ )
362 if ( ( j + 16 ) > PLPLOT_NTK_CMD_SIZE )
363 plexit(
"plD_polyline_ntk: too many x, y values to hold in static cmd array" );
364 j += sprintf( &
cmd[j],
"%.1f %.1f ", xa[i] / scale,
ymax - ya[i] / scale );
366 j += sprintf( &
cmd[j],
" -fill %s", curcolor );
367 if ( dash[0] ==
'-' )
368 j += sprintf( &
cmd[j],
" %s", dash );
381 tk_cmd(
"bind . <KeyPress> {set keypress %N}" );
388 tk_cmd(
"info exists keypress" );
389 sscanf( Tcl_GetStringResult(
interp ),
"%d", &st );
392 tk_cmd(
"set keypress" );
393 sscanf( Tcl_GetStringResult(
interp ),
"%d", &key );
395 tk_cmd(
"unset keypress" );
399 tk_cmd(
"bind . <Key> {};" );
412 create_canvas( pls );
421 tk_cmd(
"destroy $plf; wm withdraw ." );
432 sprintf( curcolor,
"#%02x%02x%02x",
450 tk_cmd(
"winfo exists $plf.f2.c$ccanv" );
451 sscanf( Tcl_GetStringResult(
interp ),
"%d", &st );
455 tk_cmd(
"set ocursor [lindex [$plf.f2.c$ccanv configure -cursor] 4]" );
458 tk_cmd(
"$plf.f2.c$ccanv configure -cursor cross;\n"
459 "bind $plf.f2.c$ccanv <Button> {set xloc %x; set yloc %y; set bloc %b; set sloc %s};\n"
460 "bind $plf.f2.c$ccanv <B1-Motion> {set xloc %x; set yloc %y; set bloc %b; set sloc %s};\n"
461 "bind $plf.f2.c$ccanv <B2-Motion> {set xloc %x; set yloc %y; set bloc %b; set sloc %s};\n"
462 "bind $plf.f2.c$ccanv <B3-Motion> {set xloc %x; set yloc %y; set bloc %b; set sloc %s};" );
467 tk_cmd(
"info exists xloc" );
468 sscanf( Tcl_GetStringResult(
interp ),
"%d", &st );
470 tk_cmd(
"set xloc" );
471 sscanf( Tcl_GetStringResult(
interp ),
"%d", &gin.
pX );
472 tk_cmd(
"set yloc" );
473 sscanf( Tcl_GetStringResult(
interp ),
"%d", &gin.
pY );
474 tk_cmd(
"set bloc" );
475 sscanf( Tcl_GetStringResult(
interp ),
"%ud", &gin.
button );
476 tk_cmd(
"set sloc" );
477 sscanf( Tcl_GetStringResult(
interp ),
"%ud", &gin.
state );
482 tk_cmd(
"bind $plf.f2.c$ccanv <ButtonPress> {};\n"
483 "bind $plf.f2.c$ccanv <ButtonMotion> {};\n"
484 "bind $plf.f2.c$ccanv <B2-Motion> {};\n"
485 "bind $plf.f2.c$ccanv <B3-Motion> {};\n"
489 tk_cmd(
"$plf.f2.c$ccanv configure -cursor {}" );
500 static const unsigned char bit_pat[] = {
501 0x24, 0x01, 0x92, 0x00, 0x49, 0x00, 0x24, 0x00, 0x12, 0x00, 0x09, 0x00,
502 0x04, 0x00, 0x02, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
503 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff
509 xa = (
short *) malloc(
sizeof (
short ) * (size_t) pls->
dev_npts );
510 ya = (
short *) malloc(
sizeof (
short ) * (size_t) pls->
dev_npts );
511 for ( i = 0; i < pls->
dev_npts; i++ )
513 xa[i] = pls->
dev_x[i];
514 ya[i] = pls->
dev_y[i];
517 j = sprintf( dash,
"-dash {" );
518 for ( i = 0; i < pls->
nms; i++ )
519 j += sprintf( &dash[j],
" %d %d",
520 (
int) ceil( pls->
mark[i] / 1e3 * ppm ),
521 (
int) ceil( pls->
space[i] / 1e3 * ppm ) );
522 sprintf( &dash[j],
"}" );
523 plD_polyline_ntk( pls, xa, ya, pls->
dev_npts );
524 free( xa ); free( ya );
537 if ( pls->
patt != 0 )
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 );
558 if ( pls->
patt != 0 )
560 Tk_DefineBitmap(
interp, Tk_GetUid(
"foo" ), (
const char *) bit_pat, 16, 16 );
563 j = sprintf(
cmd,
"$plf.f2.c%d create polygon ", ccanv );
564 for ( i = 0; i < pls->
dev_npts; i++ )
565 j += sprintf( &
cmd[j],
"%.1f %.1f ", pls->
dev_x[i] / scale,
567 j += sprintf( &
cmd[j],
" -fill %s", curcolor );
568 if ( pls->
patt != 0 )
569 sprintf( &
cmd[j],
" -stipple patt -outline black" );