// Experimental tk driver using a plain "wish" // // Copyright (C) 2001 Joao Cardoso // Copyright (C) 2004 Rafael Laboissiere // // This file is part of PLplot. // // PLplot is free software; you can redistribute it and/or modify // it under the terms of the GNU Library General Public License as published // by the Free Software Foundation; either version 2 of the License, or // (at your option) any later version. // // PLplot is distributed in the hope that it will be useful, // but WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU Library General Public License for more details. // // You should have received a copy of the GNU Library General Public License // along with PLplot; if not, write to the Free Software // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA // // #include "plDevs.h" #ifdef PLD_ntk #include "plplotP.h" #include "drivers.h" #include "plevent.h" #include // Device info PLDLLIMPEXP_DRIVER const char* plD_DEVICE_INFO_ntk = "ntk:New tk driver:1:ntk:43:ntk\n"; void plD_dispatch_init_ntk( PLDispatchTable *pdt ); void plD_init_ntk( PLStream * ); void plD_line_ntk( PLStream *, short, short, short, short ); void plD_polyline_ntk( PLStream *, short *, short *, PLINT ); void plD_eop_ntk( PLStream * ); void plD_bop_ntk( PLStream * ); void plD_tidy_ntk( PLStream * ); void plD_state_ntk( PLStream *, PLINT ); void plD_esc_ntk( PLStream *, PLINT, void * ); void plD_dispatch_init_ntk( PLDispatchTable *pdt ) { #ifndef ENABLE_DYNDRIVERS pdt->pl_MenuStr = "New Tk device"; pdt->pl_DevName = "ntk"; #endif pdt->pl_type = plDevType_Interactive; pdt->pl_seq = 43; pdt->pl_init = (plD_init_fp) plD_init_ntk; pdt->pl_line = (plD_line_fp) plD_line_ntk; pdt->pl_polyline = (plD_polyline_fp) plD_polyline_ntk; pdt->pl_eop = (plD_eop_fp) plD_eop_ntk; pdt->pl_bop = (plD_bop_fp) plD_bop_ntk; pdt->pl_tidy = (plD_tidy_fp) plD_tidy_ntk; pdt->pl_state = (plD_state_fp) plD_state_ntk; pdt->pl_esc = (plD_esc_fp) plD_esc_ntk; } // hardwired window size #define XPIXELS 600 #define YPIXELS 400 static PLFLT scale = 10.0; // Tk canvas units are in pixels, giving corse curves, fool plplot, and scale down when sending to tk static PLFLT ppm; // device pixels per mm static Tcl_Interp *interp = NULL; // tcl interpreter static Tk_Window mainw; // tk main window static char curcolor[80]; // current color in #rrggbb notation // 12000 is large enough to satisfy example 27 needs without // erroring out in plD_polyline_ntk. Quadruple that to be conservative. #define PLPLOT_NTK_CMD_SIZE 48000 static char cmd[PLPLOT_NTK_CMD_SIZE]; // buffer to build command to interp static int ccanv = 0; // current canvas number static char base[80]; // name of frame that contains the canvas static char dash[80]; // dash string, as * // line buffering #define NPTS 1000 static short xold = -1, yold = -1; // last point of last 2 points line static short xb[NPTS], yb[NPTS]; // buffer static int curpts = 0; // current number of points buffered static int local = 1; // "local" or "remote" interpreter static char rem_interp[80]; // name of remote interp // physical devices coordinates static PLINT xmin = 0; static PLINT xmax = XPIXELS; static PLINT ymin = 0; static PLINT ymax = YPIXELS; // locator static PLGraphicsIn gin; static void tk_cmd( const char *gcmd ) { static char scmd[PLPLOT_NTK_CMD_SIZE]; if ( local ) Tcl_Eval( interp, gcmd ); else { // the -async option makes it block, some times! but is *much* faster! // and was working OK till now :( // sprintf(scmd, "send -async %s {%s}", rem_interp, cmd); // sprintf( scmd, "send %s {%s}", rem_interp, gcmd ); // mess! make it more efficient if ( Tcl_Eval( interp, scmd ) != TCL_OK ) fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) ); } } static void create_canvas( PLStream *pls ) { int columnbreak; ccanv++; columnbreak = ( ccanv % 30 == 0 ); // create new canvas 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 ); tk_cmd( cmd ); // add new canvas to option menu sprintf( cmd, "$plf.f1.mb.menu add command -label \"Page $ccanv\" -columnbreak %d -command {\n" "set w $plf.f2.c%d;\n" "$hs configure -command \"$w xview\";\n" "$vs configure -command \"$w yview\";\n" "set dname \"Page %d\";\n" "pack forget $ocanvas;\n" "set ocanvas $plf.f2.c%d;\n" "pack $ocanvas -fill both -expand 1;\n" "scan [$w xview] \"%%f %%f\" i j;\n" "$hs set $i $j;\n" "scan [$w yview] \"%%f %%f\" i j;\n" "$vs set $i $j;}", columnbreak, ccanv, ccanv, ccanv ); tk_cmd( cmd ); sprintf( cmd, "set item(%d) 0", ccanv ); tk_cmd( cmd ); // Shif-B1, zooms in // FIXME inform the core lib of the zoom, see plframe.c around line 2818 sprintf( cmd, "bind $plf.f2.c$ccanv {\n" "set cc %d;\n" "incr item($cc); set tt $item($cc);\n" "if {$tt == 1} {\n" "incr scroll_use;\n" "pack $hs -side bottom -fill x;\n" "pack $vs -side right -fill y;\n" "pack forget %%W; pack %%W -fill both -expand 1}\n" "set zx($cc,$tt) %%x;\n" "set zy($cc,$tt) %%y;\n" "%%W scale all %%x %%y 1.6 1.6;\n" "%%W configure -scrollregion [%%W bbox all];\n" "}", ccanv ); tk_cmd( cmd ); // Shif-B3, zooms out sprintf( cmd, "bind $plf.f2.c$ccanv {\n" "set cc %d; set tt $item($cc);\n" "if {$tt != 0} {\n" "%%W scale all $zx($cc,$tt) $zy($cc,$tt) 0.625 0.625\n" "%%W configure -scrollregion [%%W bbox all];\n" "set item($cc) [expr $tt - 1]}\n" "if { $item($cc) == 0} {\n" "set scroll_use [expr $scroll_use - 1];\n" "if {$scroll_use == 0} {\n" "pack forget $plf.f2.hscroll $plf.f2.vscroll}\n" "%%W configure -scrollregion \"0 0 $xmax $ymax\"}}", ccanv ); tk_cmd( cmd ); // Shift-B2, resets sprintf( cmd, "bind $plf.f2.c$ccanv {\n" "set cc %d; set tt $item($cc); \n" "while {$tt != 0} {\n" "%%W scale all $zx($cc,$tt) $zy($cc,$tt) 0.625 0.625\n" "set tt [expr $tt - 1]};\n" "set item($cc) 0;\n" "%%W configure -scrollregion \"0 0 $xmax $ymax\";\n" "set scroll_use [expr $scroll_use - 1];\n" "if {$scroll_use == 0} {\n" "pack forget $plf.f2.hscroll $plf.f2.vscroll}}", ccanv ); tk_cmd( cmd ); // Control-B1-Motion, pan sprintf( cmd, "bind $plf.f2.c$ccanv \"$plf.f2.c%d scan mark %%x %%y\"", ccanv ); tk_cmd( cmd ); sprintf( cmd, "bind $plf.f2.c$ccanv \"$plf.f2.c%d scan dragto %%x %%y\"", ccanv ); tk_cmd( cmd ); // Control-B2, identify and (in the far future) edit object tk_cmd( "bind $plf.f2.c$ccanv {\n" "set xx [ expr [winfo pointerx .] - [winfo rootx %W]];\n" "set yy [ expr [winfo pointery .] - [winfo rooty %W]];\n" "set near [%W find closest $xx $yy];\n" "%W move $near 20 20;\n" "after 500 \"%W move $near -20 -20\"}" ); // change view to the new canvas by invoking the menu buttom sprintf( cmd, "$plf.f1.mb.menu invoke %d", ccanv - 1 ); tk_cmd( cmd ); } //-------------------------------------------------------------------------- // plD_init_ntk() // // Initialize device (terminal). //-------------------------------------------------------------------------- void plD_init_ntk( PLStream *pls ) { pls->dev_fill0 = 1; // Handle solid fills pls->dev_fill1 = 1; // Driver handles pattern fills pls->color = 1; // Is a color device pls->dev_dash = 1; // Handle dashed lines pls->plbuf_write = 1; // Use plot buffer strcpy( curcolor, "black" ); // default color by name, not #rrggbb if ( pls->server_name != NULL ) { local = 0; strcpy( rem_interp, pls->server_name ); } if ( pls->geometry != NULL ) sscanf( pls->geometry, "%dx%d", &xmax, &ymax ); // if ( pls->plwindow != NULL ) // strcpy( base, pls->plwindow ); // else strcpy( base, ".plf" ); // default frame containing the canvas interp = Tcl_CreateInterp(); if ( Tcl_Init( interp ) != TCL_OK ) plexit( "Unable to initialize Tcl." ); if ( Tk_Init( interp ) ) plexit( "Unable to initialize Tk." ); mainw = Tk_MainWindow( interp ); Tcl_Eval( interp, "rename exec {}" ); Tcl_Eval( interp, "tk appname PLplot_ntk" ); // give interpreter a name if ( !local ) { Tcl_Eval( interp, "wm withdraw ." ); sprintf( cmd, "send %s \"set client [tk appname]; wm deiconify .\"", rem_interp ); if ( Tcl_Eval( interp, cmd ) != TCL_OK ) { fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) ); plexit( "No such tk server." ); } } 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 ); tk_cmd( cmd ); tk_cmd( "catch \"frame $plf\"; pack $plf -fill both -expand 1" ); sprintf( cmd, "frame $plf.f1;\n" "frame $plf.f2 -width %d -height %d;\n" "pack $plf.f1 -fill x;\n" "pack $plf.f2 -fill both -expand 1", xmax, ymax ); tk_cmd( cmd ); tk_cmd( "scrollbar $plf.f2.hscroll -orient horiz;\n" "scrollbar $plf.f2.vscroll" ); tk_cmd( "menubutton $plf.f1.mb -text \"Page 1\" -textvariable dname -relief raised -indicatoron 1 -menu $plf.f1.mb.menu;\n" "menu $plf.f1.mb.menu -tearoff 0;\n" "pack $plf.f1.mb -side left" ); if ( local ) tk_cmd( "button $plf.f1.quit -text Quit -command exit;\n" "pack $plf.f1.quit -side right" ); else tk_cmd( "button $plf.f1.quit -text Quit -command {send -async $client exit;\n" "destroy $plf;\n" "wm withdraw .};\n" "pack $plf.f1.quit -side right" ); // FIXME: I just discovered that Tcl_Eval is slower than Tcl_EvalObj. Fix it global-wide, `man Tcl_Eval' // Set up device parameters Tcl_Eval( interp, "tk scaling" ); // pixels per mm ppm = (PLFLT) atof( Tcl_GetStringResult( interp ) ) / ( 25.4 / 72. ); plP_setpxl( ppm, ppm ); plP_setphy( xmin, (PLINT) ( xmax * scale ), ymin, (PLINT) ( ymax * scale ) ); tk_cmd( "update" ); } static void flushbuffer( PLStream *pls ) { if ( curpts ) { plD_polyline_ntk( pls, xb, yb, curpts ); // if (curpts != 2) fprintf(stderr,"%d ", curpts); xold = yold = -1; curpts = 0; } } void plD_line_ntk( PLStream *pls, short x1a, short y1a, short x2a, short y2a ) { if ( xold == x1a && yold == y1a ) { xold = xb[curpts] = x2a; yold = yb[curpts] = y2a; curpts++; } else { flushbuffer( pls ); xb[curpts] = x1a; yb[curpts] = y1a; curpts++; xold = xb[curpts] = x2a; yold = yb[curpts] = y2a; curpts++; } if ( curpts == NPTS ) { //fprintf( stderr, "\nflush: %d ", curpts ); flushbuffer( pls ); } } void plD_polyline_ntk( PLStream * PL_UNUSED( pls ), short *xa, short *ya, PLINT npts ) { PLINT i, j; // there must exist a way to code this using the tk C API j = sprintf( cmd, "$plf.f2.c%d create line ", ccanv ); for ( i = 0; i < npts; i++ ) { // To be completely safe, assume 5 characters to the left of the // decimal point ==> 2*(5+3) characters written per sprintf // call. if ( ( j + 16 ) > PLPLOT_NTK_CMD_SIZE ) plexit( "plD_polyline_ntk: too many x, y values to hold in static cmd array" ); j += sprintf( &cmd[j], "%.1f %.1f ", xa[i] / scale, ymax - ya[i] / scale ); } j += sprintf( &cmd[j], " -fill %s", curcolor ); if ( dash[0] == '-' ) j += sprintf( &cmd[j], " %s", dash ); tk_cmd( cmd ); } // an event loop has to be designed, getcursor() and waitforpage() are just experimental static void waitforpage( PLStream * PL_UNUSED( pls ) ) { int key = 0, st = 0; // why can't I bind to the canvas? or even any frame? //tk_cmd("bind . {set keypress %N; puts \"\n%k-%A-%K-%N\"}"); tk_cmd( "bind . {set keypress %N}" ); while ( ( key & 0xff ) != PLK_Return && ( key & 0xff ) != PLK_Linefeed && key != PLK_Next && key != 'Q' ) { while ( st != 1 ) { tk_cmd( "update" ); tk_cmd( "info exists keypress" ); sscanf( Tcl_GetStringResult( interp ), "%d", &st ); } tk_cmd( "set keypress" ); sscanf( Tcl_GetStringResult( interp ), "%d", &key ); //fprintf(stderr,"\n%d\n", key);fflush(stderr); tk_cmd( "unset keypress" ); st = 0; } tk_cmd( "bind . {};" ); } void plD_eop_ntk( PLStream *pls ) { flushbuffer( pls ); tk_cmd( "update" ); } void plD_bop_ntk( PLStream *pls ) { create_canvas( pls ); } void plD_tidy_ntk( PLStream *pls ) { if ( !pls->nopause ) waitforpage( pls ); tk_cmd( "destroy $plf; wm withdraw ." ); } void plD_state_ntk( PLStream *pls, PLINT op ) { switch ( op ) { case PLSTATE_COLOR0: case PLSTATE_COLOR1: flushbuffer( pls ); sprintf( curcolor, "#%02x%02x%02x", pls->curcolor.r, pls->curcolor.g, pls->curcolor.b ); break; } } static void getcursor( PLStream * PL_UNUSED( pls ), PLGraphicsIn *ptr ) { int st = 0; plGinInit( &gin ); if ( 0 ) { while ( st != 1 ) { tk_cmd( "update" ); tk_cmd( "winfo exists $plf.f2.c$ccanv" ); sscanf( Tcl_GetStringResult( interp ), "%d", &st ); } st = 0; // this give a "Segmentation fault", even after checking for the canvas! tk_cmd( "set ocursor [lindex [$plf.f2.c$ccanv configure -cursor] 4]" ); } tk_cmd( "$plf.f2.c$ccanv configure -cursor cross;\n" "bind $plf.f2.c$ccanv