git.maemo.org Git - gnuplot/blob - term/tkcanvas.trm

   1 /* Hello, Emacs, this is -*-C-*-
   2  * $Id: tkcanvas.trm,v 1.28 2006/08/27 22:10:46 sfeam Exp $
   3  *
   4  */
   5
   6 /* GNUPLOT - tkcanvas.trm */
   7
   8 /*[
   9  * Copyright 1990 - 1993, 1998, 2004
  10  *
  11  * Permission to use, copy, and distribute this software and its
  12  * documentation for any purpose with or without fee is hereby granted,
  13  * provided that the above copyright notice appear in all copies and
  14  * that both that copyright notice and this permission notice appear
  15  * in supporting documentation.
  16  *
  17  * Permission to modify the software is granted, but not the right to
  18  * distribute the complete modified source code.  Modifications are to
  19  * be distributed as patches to the released version.  Permission to
  20  * distribute binaries produced by compiling modified sources is granted,
  21  * provided you
  22  *   1. distribute the corresponding source modifications from the
  23  *    released version in the form of a patch file along with the binaries,
  24  *   2. add special version identification to distinguish your version
  25  *    in addition to the base release version number,
  26  *   3. provide your name and address as the primary contact for the
  27  *    support of your modified version, and
  28  *   4. retain our contact information in regard to use of the base
  29  *    software.
  30  * Permission to distribute the released version of the source code along
  31  * with corresponding source modifications in the form of a patch file is
  32  * granted with same provisions 2 through 4 for binary distributions.
  33  *
  34  * This software is provided "as is" without express or implied warranty
  35  * to the extent permitted by applicable law.
  36 ]*/
  37
  38 /*
  39  * This file is included by ../term.c.
  40  *
  41  * This terminal driver supports:
  42  *  Tk/Tcl canvas widgets
  43  *
  44  * AUTHORS - original dxy.trm
  45  *  Martin Yii, eln557h@monu3.OZ
  46  *  Further modified Jan 1990 by Russell Lang, rjl@monu1.cc.monash.oz
  47  *
  48  * Port to the Tk/Tcl canvas widget
  49  *  D. Jeff Dionne, July 1995 jeff@ryeham.ee.ryerson.ca
  50  *  Alex Woo, woo@playfair.stanford.edu
  51  *
  52  * send your comments or suggestions to (gnuplot-info@lists.sourceforge.net).
  53  *
  54  */
  55
  56 /*
  57  * adapted to the new terminal layout by Alex Woo (Sept. 1996)
  58  */
  59
  60 /*
  61  * extended interactive Tk/Tcl capabilities
  62  * Thomas Sefzick, March 1999, t.sefzick@fz-juelich.de
  63  *
  64  * added the perltk.trm code written by Slaven Rezic <eserte@cs.tu-berlin.de>,
  65  * the variable 'tk_perl' switches between tcl/tk and perltk code.
  66  * 'linewidth' and 'justify text' added, ends of plotted lines are now rounded.
  67  * Thomas Sefzick, May 1999, t.sefzick@fz-juelich.de
  68  *
  69  * scale plot to fit into the actual size of the canvas as reported by
  70  * the window manager (the canvas itself doesn't report its real size).
  71  * Matt Willis, October 1999, mattbwillis@my-deja.com
  72  */
  73
  74 #include "driver.h"
  75
  76 #ifdef TERM_REGISTER
  77 register_term(tkcanvas)
  78 #endif
  79
  80 #ifdef TERM_PROTO
  81 TERM_PUBLIC void TK_options __PROTO((void));
  82 TERM_PUBLIC void TK_init __PROTO((void));
  83 TERM_PUBLIC void TK_graphics __PROTO((void));
  84 TERM_PUBLIC void TK_text __PROTO((void));
  85 TERM_PUBLIC void TK_linetype __PROTO((int linetype));
  86 TERM_PUBLIC void TK_move __PROTO((unsigned int x, unsigned int y));
  87 TERM_PUBLIC void TK_vector __PROTO((unsigned int x, unsigned int y));
  88 TERM_PUBLIC void TK_put_text __PROTO((unsigned int x, unsigned int y, const char *str));
  89 TERM_PUBLIC void TK_reset __PROTO((void));
  90 TERM_PUBLIC int TK_justify_text __PROTO((enum JUSTIFY));
  91 TERM_PUBLIC int TK_set_font __PROTO((const char *font));
  92 TERM_PUBLIC void TK_linewidth __PROTO((double linewidth));
  93
  94 #define TK_XMAX 1000
  95 #define TK_YMAX 1000
  96
  97 #define TK_XLAST (TK_XMAX - 1)
  98 #define TK_YLAST (TK_XMAX - 1)
  99
 100 #define TK_VCHAR        (25)    /* double actual height of characters */
 101 #define TK_HCHAR        (16)    /* actual width including spacing */
 102 #define TK_VTIC (18)
 103 #define TK_HTIC (18)
 104 #endif /* TERM_PROTO */
 105
 106 #ifndef TERM_PROTO_ONLY
 107 #ifdef TERM_BODY
 108
 109 /* axis.c */
 110 /* FIXME HBB 20000725: "Never use extern in a source file". This needs
 111  * to be fixed.  As is, this driver causes the terminal layer to
 112  * depend on several other core modules. The lack of proper #include's
 113  * partly hides this, but it's still a design bug. "term" is supposed
 114  * a 'frontier' layer: it should not be dependant on any other code
 115  * inside gnuplot */
 116 extern AXIS axis_array[];
 117 /* command.c */
 118 extern TBOOLEAN is_3d_plot;
 119
 120 /* static int tk_angle = 0; unused, for now */
 121 static int tk_lastx;
 122 static int tk_lasty;
 123 static int tk_color = 0;
 124 static char tk_anchor[7] = "w";
 125 static double tk_linewidth = 1.0;
 126 static int tk_perl = 0;
 127 static int tk_interactive = 0;
 128 static const char *tk_colors[] = {
 129     "black", "gray", "red", "blue", "green", "brown", "magenta", "cyan"
 130 };
 131
 132 enum TK_id { TK_PERLTK, TK_INTERACTIVE, TK_OTHER };
 133
 134 static struct gen_table TK_opts[] =
 135 {
 136     { "p$erltk", TK_PERLTK },
 137     { "i$nteractive", TK_INTERACTIVE },
 138     { NULL, TK_OTHER }
 139 };
 140
 141 TERM_PUBLIC void
 142 TK_options()
 143 {
 144     tk_perl = 0;
 145     tk_interactive = 0;
 146
 147     while (!END_OF_COMMAND) {
 148         switch(lookup_table(&TK_opts[0],c_token)) {
 149         case TK_PERLTK:
 150             tk_perl = 1;
 151             c_token++;
 152             break;
 153         case TK_INTERACTIVE:
 154             tk_interactive = 1;
 155             c_token++;
 156             break;
 157         case TK_OTHER:
 158         default:
 159             c_token++;
 160             break;
 161         }
 162     }
 163
 164     sprintf(term_options, "%s %s",
 165             tk_perl ? "perltk" : "",
 166             tk_interactive ? "interactive" : "");
 167 }
 168
 169 TERM_PUBLIC void
 170 TK_init()
 171 {
 172 }
 173
 174 TERM_PUBLIC void
 175 TK_graphics()
 176 {
 177         /*
 178          * the resulting tcl or perl code takes the actual width and height
 179          * of the defined canvas and scales the plot to fit.
 180          * => NOTE: this makes 'set size' useless !!!
 181          * unless the original width and height is taken into account
 182          * by some tcl or perl code, that's why the 'gnuplot_plotarea' and
 183          * 'gnuplot_axisranges' procedures are supplied.
 184          */
 185     if (tk_perl) {
 186         fputs("\
 187 sub {\n\
 188 my($can) = @_;\n\
 189 $can->delete('all');\n\
 190 my $cmx = $can->width - 2 * $can->cget(-border) - 2 * $can->cget(-highlightthickness);\n\
 191 if ($cmx <= 1) {\n$cmx = ($can->cget(-width));\n}\n\
 192 my $cmy = $can->height - 2 * $can->cget(-border) - 2 * $can->cget(-highlightthickness);\n\
 193 if ($cmy <= 1) {\n$cmy = ($can->cget(-height));\n}\n",
 194               gpoutfile);
 195     } else {
 196         fputs("\
 197 proc gnuplot can {\n\
 198 $can delete all\n\
 199 set cmx [expr [winfo width $can]-2*[$can cget -border]-2*[$can cget -highlightthickness]]\n\
 200 if {$cmx <= 1} {set cmx [$can cget -width]}\n\
 201 set cmy [expr [winfo height $can]-2*[$can cget -border]-2*[$can cget -highlightthickness]]\n\
 202 if {$cmy <= 1} {set cmy [$can cget -height]}\n",
 203               gpoutfile);
 204     }
 205     tk_lastx = tk_lasty = tk_color = 0;
 206 }
 207
 208 TERM_PUBLIC void
 209 TK_reset()
 210 {
 211 }
 212
 213 TERM_PUBLIC void
 214 TK_linetype(int linetype)
 215 {
 216     if (linetype < -2)
 217         linetype = LT_BLACK;
 218     tk_color = (linetype + 2) & 7;
 219 }
 220
 221 TERM_PUBLIC void
 222 TK_linewidth(double linewidth)
 223 {
 224     tk_linewidth = linewidth;
 225 }
 226
 227 TERM_PUBLIC void
 228 TK_move(unsigned int x, unsigned int y)
 229 {
 230     tk_lastx = x;
 231     tk_lasty = 1000 - y;
 232 }
 233
 234 /* FIXME HBB 20000725: should use AXIS_UNDO_LOG() macro... */
 235 #define TK_REAL_VALUE(value,axis)                               \
 236 (axis_array[axis].log)                                          \
 237     ? pow(axis_array[axis].base, axis_array[axis].min           \
 238           + value*(axis_array[axis].max-axis_array[axis].min))  \
 239         : axis_array[axis].min                                  \
 240           + value*(axis_array[axis].max-axis_array[axis].min)
 241
 242 #define TK_X_VALUE(value) \
 243  (double)(value-plot_bounds.xleft)/(double)(plot_bounds.xright-plot_bounds.xleft)
 244
 245 #define TK_Y_VALUE(value) \
 246  (double)((TK_YMAX-value)-plot_bounds.ybot)/(double)(plot_bounds.ytop-plot_bounds.ybot)
 247
 248 TERM_PUBLIC void
 249 TK_vector(unsigned int x, unsigned int y)
 250 {
 251         /*
 252          * this is the 1st part of the wrapper around the 'create line' command
 253          * used to bind some actions to a line segment:
 254          * bind {
 255          *      normal create line command
 256          *      } gnuplot_xy(some coordinates)
 257          */
 258     if (tk_interactive && !is_3d_plot) {
 259         if (tk_perl)
 260             fprintf(gpoutfile, "$can->bind(");
 261         else
 262             fprintf(gpoutfile, "$can bind [\n");
 263     }
 264         /*
 265          * end of 1st part of wrapper
 266          */
 267     y = 1000 - y;
 268         /*
 269          * here is the basic well-known command for plotting a line segment
 270          */
 271     if (tk_perl) {
 272         fprintf(gpoutfile,"\
 273 $can->createLine(\
 274 $cmx * %d / 1000, \
 275 $cmy * %d / 1000, \
 276 $cmx * %d / 1000, \
 277 $cmy * %d / 1000, -fill => q{%s}, -width => %f, -capstyle => q{round})",
 278                 tk_lastx, tk_lasty, x, y, tk_colors[tk_color], tk_linewidth);
 279     } else {
 280         fprintf(gpoutfile,"\
 281 $can create line \
 282 [expr $cmx * %d /1000] \
 283 [expr $cmy * %d /1000] \
 284 [expr $cmx * %d /1000] \
 285 [expr $cmy * %d /1000] -fill %s -width %f -capstyle round\n",
 286                 tk_lastx, tk_lasty, x, y, tk_colors[tk_color], tk_linewidth);
 287     }
 288
 289         /*
 290          * this is the 2nd part of the wrapper around the 'create line'
 291          * command it generates a mechanism which calls 'gnuplot_xy' for
 292          * the line segment pointed to by the mouse cursor when a mouse
 293          * button is pressed
 294          */
 295     if (tk_interactive && !is_3d_plot) {
 296         if (tk_perl) {
 297             /* Ev('W') not needed here, supplied anyhow, WHY ??? */
 298             fprintf(gpoutfile,"\
 299 , '<Button>' => \
 300 [\\&gnuplot_xy, %f, %f, %f, %f, %f, %f, %f, %f,",
 301                     TK_REAL_VALUE(TK_X_VALUE(tk_lastx), FIRST_X_AXIS),
 302                     TK_REAL_VALUE(TK_Y_VALUE(tk_lasty), FIRST_Y_AXIS),
 303                     TK_REAL_VALUE(TK_X_VALUE(tk_lastx), SECOND_X_AXIS),
 304                     TK_REAL_VALUE(TK_Y_VALUE(tk_lasty), SECOND_Y_AXIS),
 305                     TK_REAL_VALUE(TK_X_VALUE(x), FIRST_X_AXIS),
 306                     TK_REAL_VALUE(TK_Y_VALUE(y), FIRST_Y_AXIS),
 307                     TK_REAL_VALUE(TK_X_VALUE(x), SECOND_X_AXIS),
 308                     TK_REAL_VALUE(TK_Y_VALUE(y), SECOND_Y_AXIS));
 309             if (axis_array[FIRST_X_AXIS].log) {
 310                 fprintf(gpoutfile, " %f,",
 311                         TK_REAL_VALUE(TK_X_VALUE(0.5 * (x + tk_lastx)), FIRST_X_AXIS));
 312             } else {
 313                 fprintf(gpoutfile, " \"\",");
 314             }
 315             if (axis_array[FIRST_Y_AXIS].log) {
 316                 fprintf(gpoutfile, " %f,",
 317                         TK_REAL_VALUE(TK_Y_VALUE(0.5 * (y + tk_lasty)), FIRST_Y_AXIS));
 318             } else {
 319                 fprintf(gpoutfile, " \"\",");
 320             }
 321             if (axis_array[SECOND_X_AXIS].log) {
 322                 fprintf(gpoutfile, " %f,",
 323                         TK_REAL_VALUE(TK_X_VALUE(0.5 * (x + tk_lastx)), SECOND_X_AXIS));
 324             } else {
 325                 fprintf(gpoutfile, " \"\",");
 326             }
 327             if (axis_array[SECOND_Y_AXIS].log) {
 328                 fprintf(gpoutfile, " %f",
 329                         TK_REAL_VALUE(TK_Y_VALUE(0.5 * (y + tk_lasty)), SECOND_Y_AXIS));
 330             } else {
 331                 fprintf(gpoutfile, " \"\"");
 332             }
 333             fprintf(gpoutfile, "]);\n");
 334         } else {
 335             fprintf(gpoutfile,"\
 336 ] <Button> \
 337 \"gnuplot_xy %%W %f %f %f %f %f %f %f %f",
 338                     TK_REAL_VALUE(TK_X_VALUE(tk_lastx), FIRST_X_AXIS),
 339                     TK_REAL_VALUE(TK_Y_VALUE(tk_lasty), FIRST_Y_AXIS),
 340                     TK_REAL_VALUE(TK_X_VALUE(tk_lastx), SECOND_X_AXIS),
 341                     TK_REAL_VALUE(TK_Y_VALUE(tk_lasty), SECOND_Y_AXIS),
 342                     TK_REAL_VALUE(TK_X_VALUE(x), FIRST_X_AXIS),
 343                     TK_REAL_VALUE(TK_Y_VALUE(y), FIRST_Y_AXIS),
 344                     TK_REAL_VALUE(TK_X_VALUE(x), SECOND_X_AXIS),
 345                     TK_REAL_VALUE(TK_Y_VALUE(y), SECOND_Y_AXIS));
 346             if (axis_array[FIRST_X_AXIS].log) {
 347                 fprintf(gpoutfile, " %f",
 348                         TK_REAL_VALUE(TK_X_VALUE(0.5 * (x + tk_lastx)), FIRST_X_AXIS));
 349             } else {
 350                 fprintf(gpoutfile, " {}");
 351             }
 352             if (axis_array[FIRST_Y_AXIS].log) {
 353                 fprintf(gpoutfile, " %f",
 354                         TK_REAL_VALUE(TK_Y_VALUE(0.5 * (y + tk_lasty)), FIRST_Y_AXIS));
 355             } else {
 356                 fprintf(gpoutfile, " {}");
 357             }
 358             if (axis_array[SECOND_X_AXIS].log) {
 359                 fprintf(gpoutfile, " %f",
 360                         TK_REAL_VALUE(TK_X_VALUE(0.5 * (x + tk_lastx)), SECOND_X_AXIS));
 361             } else {
 362                 fprintf(gpoutfile, " {}");
 363             }
 364             if (axis_array[SECOND_Y_AXIS].log) {
 365                 fprintf(gpoutfile, " %f",
 366                         TK_REAL_VALUE(TK_Y_VALUE(0.5 * (y + tk_lasty)), SECOND_Y_AXIS));
 367             } else {
 368                 fprintf(gpoutfile, " {}");
 369             }
 370             fprintf(gpoutfile, "\"\n");
 371         }
 372     } else {
 373         if (tk_perl) {
 374             fprintf(gpoutfile, ";\n");
 375         }
 376     }
 377         /*
 378          * end of the wrapper
 379          */
 380     tk_lastx = x;
 381     tk_lasty = y;
 382 }
 383
 384 #undef TK_REAL_VALUE
 385 #undef TK_X_VALUE
 386 #undef TK_Y_VALUE
 387
 388 TERM_PUBLIC void
 389 TK_put_text(unsigned int x, unsigned int y, const char *str)
 390 {
 391     y = 1000 - y;
 392     if (tk_perl) {
 393         fprintf(gpoutfile,"\
 394 $can->createText($cmx * %d / 1000, $cmy * %d / 1000, -text => q{%s}, \
 395 -fill => q{%s}, -anchor => '%s', (defined $font ? (-font => $font) : ()));\n",
 396                 x, y, str, tk_colors[tk_color], tk_anchor);
 397     } else {
 398         /* Have to quote-protect '[' and ']' characters */
 399         int i, newsize = 0;
 400         char *quoted_str;
 401
 402         for (i=0; str[i] != '\0'; i++) {
 403             if ((str[i] == '[') || (str[i] == ']'))
 404                 newsize++;
 405             newsize++;
 406         }
 407         quoted_str = gp_alloc(newsize + 1, "TK_put_text: quoted string");
 408
 409         for (i=0, newsize = 0; str[i] != '\0'; i++) {
 410             if ((str[i] == '[') || (str[i] == ']'))
 411                 quoted_str[newsize++] = '\\';
 412             quoted_str[newsize++] = str[i];
 413         }
 414         quoted_str[newsize] = '\0';
 415         fprintf(gpoutfile,"\
 416 eval $can create text \
 417 [expr $cmx * %d /1000] \
 418 [expr $cmy * %d /1000] \
 419 -text \\{%s\\} -fill %s -anchor %s\
 420  [expr [info exists font]?\"-font \\$font\":{}]\n",
 421                 x, y, quoted_str, tk_colors[tk_color], tk_anchor);
 422        free(quoted_str);
 423     } /* else (!tk_perl) */
 424 }
 425
 426 TERM_PUBLIC int
 427 TK_justify_text(enum JUSTIFY anchor)
 428 {
 429     int return_value;
 430
 431     switch (anchor) {
 432     case RIGHT:
 433         strcpy(tk_anchor, "e");
 434         return_value = TRUE;
 435         break;
 436     case CENTRE:
 437         strcpy(tk_anchor, "center");
 438         return_value = TRUE;
 439         break;
 440     case LEFT:
 441         strcpy(tk_anchor, "w");
 442         return_value = TRUE;
 443         break;
 444     default:
 445         strcpy(tk_anchor, "w");
 446         return_value = FALSE;
 447     }
 448     return return_value;
 449 }
 450
 451 TERM_PUBLIC int
 452 TK_set_font(const char *font)
 453 {
 454     if (!font || *font == NUL) {
 455         if (tk_perl)
 456             fputs("undef $font;\n", gpoutfile);
 457         else
 458             fputs("catch {unset $font}\n", gpoutfile);
 459     } else {
 460         char *name;
 461         int size = 0;
 462         size_t sep = strcspn(font, ",");
 463
 464         name = malloc(sep + 1);
 465         if (!name)
 466             return FALSE;
 467         strncpy(name, font, sep);
 468         name[sep] = NUL;
 469         if (sep < strlen(font))
 470             sscanf(&(font[sep + 1]), "%d", &size);
 471         if (tk_perl) {
 472             fprintf(gpoutfile,"\
 473 if ($can->can('fontCreate')) {\n\
 474 $font = $can->fontCreate(-family => q{%s}",
 475                     name);
 476             if (size)
 477                 fprintf(gpoutfile, ", -size => %d", size);
 478             fputs(");\n}\n", gpoutfile);
 479         } else {
 480             fprintf(gpoutfile, "set font [font create -family %s", name);
 481             if (size)
 482                 fprintf(gpoutfile, " -size %d", size);
 483             fputs("]\n", gpoutfile);
 484         }
 485         free(name);
 486     }
 487     return TRUE;
 488 }
 489
 490 TERM_PUBLIC void
 491 TK_text()
 492 {
 493         /*
 494          * when switching back to text mode some procedures are generated which
 495          * return important information about plotarea size and axis ranges:
 496          * 'gnuplot_plotarea' returns the plotarea size in tkcanvas units
 497          * 'gnuplot_axisranges' returns the min. and max. values of the axis
 498          * these are essentially needed to set the size of the canvas when the
 499          * axis scaling is important.
 500          * moreover, a procedure 'gnuplot_xy' is created which contains the
 501          * actions bound to line segments (see the above 'TK_vector' code):
 502          * if the user has defined a procedure named 'user_gnuplot_coordinates'
 503          * then 'gnuplot_xy' calls this procedure, otherwise is writes the
 504          * coordinates of the line segment the mouse cursor is pointing to
 505          * to standard output.
 506          */
 507     if (tk_perl) {
 508         fputs("};\n", gpoutfile);
 509         if (!is_3d_plot) {
 510             fputs("sub gnuplot_plotarea {\n", gpoutfile);
 511             fprintf(gpoutfile,
 512                     "return (%d, %d, %d, %d);\n",
 513                     plot_bounds.xleft, plot_bounds.xright, 1000 - plot_bounds.ytop, 1000 - plot_bounds.ybot);
 514             fputs("};\n", gpoutfile);
 515             fputs("sub gnuplot_axisranges {\n", gpoutfile);
 516             fprintf(gpoutfile,
 517                     "return (%f, %f, %f, %f, %f, %f, %f, %f);\n",
 518                     axis_array[FIRST_X_AXIS].min, axis_array[FIRST_X_AXIS].max,
 519                     axis_array[FIRST_Y_AXIS].min, axis_array[FIRST_Y_AXIS].max,
 520                     axis_array[SECOND_X_AXIS].min, axis_array[SECOND_X_AXIS].max,
 521                     axis_array[SECOND_Y_AXIS].min, axis_array[SECOND_Y_AXIS].max);
 522             fputs("};\n", gpoutfile);
 523             if (tk_interactive) {
 524                 fputs("sub gnuplot_xy {\n",
 525                       gpoutfile);
 526                 fputs("my ($win, $x1s, $y1s, $x2s, $y2s, $x1e, $y1e, $x2e, $y2e, $x1m, $y1m, $x2m, $y2m) = @_;\n",
 527                       gpoutfile);
 528                 fputs("if (defined &user_gnuplot_coordinates) {\n",
 529                       gpoutfile);
 530                 fputs("my $id = $win->find('withtag', 'current');\n",
 531                       gpoutfile);
 532                 fputs("user_gnuplot_coordinates $win, $id, $x1s, $y1s, $x2s, $y2s, $x1e, $y1e, $x2e, $y2e, $x1m, $y1m, $x2m, $y2m\n",
 533                       gpoutfile);
 534                 fputs("} else {\n",
 535                       gpoutfile);
 536                 fputs("if (length($x1m)>0) {print \" $x1m\";} else {print \" \", 0.5*($x1s+$x1e);}\n",
 537                       gpoutfile);
 538                 fputs("if (length($y1m)>0) {print \" $y1m\";} else {print \" \", 0.5*($y1s+$y1e);}\n",
 539                       gpoutfile);
 540                 fputs("if (length($x2m)>0) {print \" $x2m\";} else {print \" \", 0.5*($x2s+$x2e);}\n",
 541                       gpoutfile);
 542                 fputs("if (length($y2m)>0) {print \" $y2m\";} else {print \" \", 0.5*($y2s+$y2e);}\n",
 543                       gpoutfile);
 544                 fputs("print \"\\n\"\n",
 545                       gpoutfile);
 546                 fputs("}\n",
 547                       gpoutfile);
 548                 fputs("};\n", gpoutfile);
 549             }
 550         }
 551     } else {
 552         fputs("}\n", gpoutfile);
 553         if (!is_3d_plot) {
 554             fputs("proc gnuplot_plotarea {} {\n", gpoutfile);
 555             fprintf(gpoutfile,
 556                     "return {%d %d %d %d}\n",
 557                     plot_bounds.xleft, plot_bounds.xright, 1000 - plot_bounds.ytop, 1000 - plot_bounds.ybot);
 558             fputs("}\n", gpoutfile);
 559             fputs("proc gnuplot_axisranges {} {\n", gpoutfile);
 560             fprintf(gpoutfile,
 561                     "return {%f %f %f %f %f %f %f %f}\n",
 562                     axis_array[FIRST_X_AXIS].min, axis_array[FIRST_X_AXIS].max,
 563                     axis_array[FIRST_Y_AXIS].min, axis_array[FIRST_Y_AXIS].max,
 564                     axis_array[SECOND_X_AXIS].min, axis_array[SECOND_X_AXIS].max,
 565                     axis_array[SECOND_Y_AXIS].min, axis_array[SECOND_Y_AXIS].max);
 566             fputs("}\n", gpoutfile);
 567             if (tk_interactive) {
 568                 fputs("proc gnuplot_xy {win x1s y1s x2s y2s x1e y1e x2e y2e x1m y1m x2m y2m} {\n",
 569                       gpoutfile);
 570                 fputs("if {([llength [info commands user_gnuplot_coordinates]])} {\n",
 571                       gpoutfile);
 572                 fputs("set id [$win find withtag current]\n",
 573                       gpoutfile);
 574                 fputs("user_gnuplot_coordinates $win $id $x1s $y1s $x2s $y2s $x1e $y1e $x2e $y2e $x1m $y1m $x2m $y2m\n",
 575                       gpoutfile);
 576                 fputs("} else {\n", gpoutfile);
 577                 fputs("if {[string length $x1m]>0} {puts -nonewline \" $x1m\"} else {puts -nonewline \" [expr 0.5*($x1s+$x1e)]\"}\n",
 578                       gpoutfile);
 579                 fputs("if {[string length $y1m]>0} {puts -nonewline \" $y1m\"} else {puts -nonewline \" [expr 0.5*($y1s+$y1e)]\"}\n",
 580                       gpoutfile);
 581                 fputs("if {[string length $x2m]>0} {puts -nonewline \" $x2m\"} else {puts -nonewline \" [expr 0.5*($x2s+$x2e)]\"}\n",
 582                       gpoutfile);
 583                 fputs("if {[string length $y2m]>0} {puts \" $y2m\"} else {puts \" [expr 0.5*($y2s+$y2e)]\"}\n",
 584                       gpoutfile);
 585                 fputs("}\n", gpoutfile);
 586                 fputs("}\n", gpoutfile);
 587             }
 588         }
 589     }
 590     fflush(gpoutfile);
 591 }
 592
 593 #endif /* TERM_BODY */
 594
 595 #ifdef TERM_TABLE
 596
 597 TERM_TABLE_START(tkcanvas)
 598     "tkcanvas", "Tk/Tcl canvas widget [perltk] [interactive]",
 599     TK_XMAX, TK_YMAX, TK_VCHAR, TK_HCHAR,
 600     TK_VTIC, TK_HTIC, TK_options, TK_init, TK_reset,
 601     TK_text, null_scale, TK_graphics, TK_move, TK_vector,
 602     TK_linetype, TK_put_text, null_text_angle,
 603     TK_justify_text, do_point, do_arrow, TK_set_font,
 604     NULL, 0, NULL, NULL, NULL, TK_linewidth
 605 TERM_TABLE_END(tkcanvas)
 606 #undef LAST_TERM
 607 #define LAST_TERM tkcanvas
 608
 609 #endif /* TERM_TABLE */
 610 #endif /* TERM_PROTO_ONLY */
 611
 612 #ifdef TERM_HELP
 613 START_HELP(tkcanvas)
 614 "1 tkcanvas",
 615 "?commands set terminal tkcanvas",
 616 "?set terminal tkcanvas",
 617 "?set term tkcanvas",
 618 "?terminal tkcanvas",
 619 "?term tkcanvas",
 620 "?tkcanvas",
 621 " This terminal driver generates Tk canvas widget commands based on Tcl/Tk",
 622 " (default) or Perl.  To use it, rebuild `gnuplot` (after uncommenting or",
 623 " inserting the appropriate line in \"term.h\"), then",
 624 "",
 625 "  gnuplot> set term tkcanvas {perltk} {interactive}",
 626 "  gnuplot> set output 'plot.file'",
 627 "",
 628 " After invoking \"wish\", execute the following sequence of Tcl/Tk commands:",
 629 "",
 630 "  % source plot.file",
 631 "  % canvas .c",
 632 "  % pack .c",
 633 "  % gnuplot .c",
 634 "",
 635 " Or, for Perl/Tk use a program like this:",
 636 "",
 637 "  use Tk;",
 638 "  my $top = MainWindow->new;",
 639 "  my $c = $top->Canvas->pack;",
 640 "  my $gnuplot = do \"plot.pl\";",
 641 "  $gnuplot->($c);",
 642 "  MainLoop;",
 643 "",
 644 " The code generated by `gnuplot` creates a procedure called \"gnuplot\"",
 645 " that takes the name of a canvas as its argument.  When the procedure is",
 646 " called, it clears the canvas, finds the size of the canvas and draws the plot",
 647 " in it, scaled to fit.",
 648 "",
 649 " For 2-dimensional plotting (`plot`) two additional procedures are defined:",
 650 " \"gnuplot_plotarea\" will return a list containing the borders of the plotting",
 651 " area \"xleft, xright, ytop, ybot\" in canvas screen coordinates, while the ranges",
 652 " of the two axes \"x1min, x1max, y1min, y1max, x2min, x2max, y2min, y2max\" in plot",
 653 " coordinates can be obtained calling \"gnuplot_axisranges\".",
 654 " If the \"interactive\" option is specified, mouse clicking on a line segment",
 655 " will print the coordinates of its midpoint to stdout. Advanced actions",
 656 " can happen instead if the user supplies a procedure named",
 657 " \"user_gnuplot_coordinates\", which takes the following arguments:",
 658 " \"win id x1s y1s x2s y2s x1e y1e x2e y2e x1m y1m x2m y2m\",",
 659 " the name of the canvas and the id of the line segment followed by the",
 660 " coordinates of its start and end point in the two possible axis ranges; the",
 661 " coordinates of the midpoint are only filled for logarithmic axes.",
 662 "",
 663 " The current version of `tkcanvas` supports neither `multiplot` nor `replot`."
 664 END_HELP(tkcanvas)
 665 #endif