1 /* Hello, Emacs, this is -*-C-*-
2 * $Id: tkcanvas.trm,v 1.28 2006/08/27 22:10:46 sfeam Exp $
6 /* GNUPLOT - tkcanvas.trm */
9 * Copyright 1990 - 1993, 1998, 2004
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.
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,
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
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.
34 * This software is provided "as is" without express or implied warranty
35 * to the extent permitted by applicable law.
39 * This file is included by ../term.c.
41 * This terminal driver supports:
42 * Tk/Tcl canvas widgets
44 * AUTHORS - original dxy.trm
45 * Martin Yii, eln557h@monu3.OZ
46 * Further modified Jan 1990 by Russell Lang, rjl@monu1.cc.monash.oz
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
52 * send your comments or suggestions to (gnuplot-info@lists.sourceforge.net).
57 * adapted to the new terminal layout by Alex Woo (Sept. 1996)
61 * extended interactive Tk/Tcl capabilities
62 * Thomas Sefzick, March 1999, t.sefzick@fz-juelich.de
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
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
77 register_term(tkcanvas)
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));
97 #define TK_XLAST (TK_XMAX - 1)
98 #define TK_YLAST (TK_XMAX - 1)
100 #define TK_VCHAR (25) /* double actual height of characters */
101 #define TK_HCHAR (16) /* actual width including spacing */
104 #endif /* TERM_PROTO */
106 #ifndef TERM_PROTO_ONLY
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
116 extern AXIS axis_array[];
118 extern TBOOLEAN is_3d_plot;
120 /* static int tk_angle = 0; unused, for now */
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"
132 enum TK_id { TK_PERLTK, TK_INTERACTIVE, TK_OTHER };
134 static struct gen_table TK_opts[] =
136 { "p$erltk", TK_PERLTK },
137 { "i$nteractive", TK_INTERACTIVE },
147 while (!END_OF_COMMAND) {
148 switch(lookup_table(&TK_opts[0],c_token)) {
164 sprintf(term_options, "%s %s",
165 tk_perl ? "perltk" : "",
166 tk_interactive ? "interactive" : "");
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.
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",
197 proc gnuplot can {\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",
205 tk_lastx = tk_lasty = tk_color = 0;
214 TK_linetype(int linetype)
218 tk_color = (linetype + 2) & 7;
222 TK_linewidth(double linewidth)
224 tk_linewidth = linewidth;
228 TK_move(unsigned int x, unsigned int y)
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)
242 #define TK_X_VALUE(value) \
243 (double)(value-plot_bounds.xleft)/(double)(plot_bounds.xright-plot_bounds.xleft)
245 #define TK_Y_VALUE(value) \
246 (double)((TK_YMAX-value)-plot_bounds.ybot)/(double)(plot_bounds.ytop-plot_bounds.ybot)
249 TK_vector(unsigned int x, unsigned int y)
252 * this is the 1st part of the wrapper around the 'create line' command
253 * used to bind some actions to a line segment:
255 * normal create line command
256 * } gnuplot_xy(some coordinates)
258 if (tk_interactive && !is_3d_plot) {
260 fprintf(gpoutfile, "$can->bind(");
262 fprintf(gpoutfile, "$can bind [\n");
265 * end of 1st part of wrapper
269 * here is the basic well-known command for plotting a line segment
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);
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);
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
295 if (tk_interactive && !is_3d_plot) {
297 /* Ev('W') not needed here, supplied anyhow, WHY ??? */
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));
313 fprintf(gpoutfile, " \"\",");
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));
319 fprintf(gpoutfile, " \"\",");
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));
325 fprintf(gpoutfile, " \"\",");
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));
331 fprintf(gpoutfile, " \"\"");
333 fprintf(gpoutfile, "]);\n");
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));
350 fprintf(gpoutfile, " {}");
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));
356 fprintf(gpoutfile, " {}");
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));
362 fprintf(gpoutfile, " {}");
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));
368 fprintf(gpoutfile, " {}");
370 fprintf(gpoutfile, "\"\n");
374 fprintf(gpoutfile, ";\n");
389 TK_put_text(unsigned int x, unsigned int y, const char *str)
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);
398 /* Have to quote-protect '[' and ']' characters */
402 for (i=0; str[i] != '\0'; i++) {
403 if ((str[i] == '[') || (str[i] == ']'))
407 quoted_str = gp_alloc(newsize + 1, "TK_put_text: quoted string");
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];
414 quoted_str[newsize] = '\0';
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);
423 } /* else (!tk_perl) */
427 TK_justify_text(enum JUSTIFY anchor)
433 strcpy(tk_anchor, "e");
437 strcpy(tk_anchor, "center");
441 strcpy(tk_anchor, "w");
445 strcpy(tk_anchor, "w");
446 return_value = FALSE;
452 TK_set_font(const char *font)
454 if (!font || *font == NUL) {
456 fputs("undef $font;\n", gpoutfile);
458 fputs("catch {unset $font}\n", gpoutfile);
462 size_t sep = strcspn(font, ",");
464 name = malloc(sep + 1);
467 strncpy(name, font, sep);
469 if (sep < strlen(font))
470 sscanf(&(font[sep + 1]), "%d", &size);
473 if ($can->can('fontCreate')) {\n\
474 $font = $can->fontCreate(-family => q{%s}",
477 fprintf(gpoutfile, ", -size => %d", size);
478 fputs(");\n}\n", gpoutfile);
480 fprintf(gpoutfile, "set font [font create -family %s", name);
482 fprintf(gpoutfile, " -size %d", size);
483 fputs("]\n", gpoutfile);
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.
508 fputs("};\n", gpoutfile);
510 fputs("sub gnuplot_plotarea {\n", 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);
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",
526 fputs("my ($win, $x1s, $y1s, $x2s, $y2s, $x1e, $y1e, $x2e, $y2e, $x1m, $y1m, $x2m, $y2m) = @_;\n",
528 fputs("if (defined &user_gnuplot_coordinates) {\n",
530 fputs("my $id = $win->find('withtag', 'current');\n",
532 fputs("user_gnuplot_coordinates $win, $id, $x1s, $y1s, $x2s, $y2s, $x1e, $y1e, $x2e, $y2e, $x1m, $y1m, $x2m, $y2m\n",
536 fputs("if (length($x1m)>0) {print \" $x1m\";} else {print \" \", 0.5*($x1s+$x1e);}\n",
538 fputs("if (length($y1m)>0) {print \" $y1m\";} else {print \" \", 0.5*($y1s+$y1e);}\n",
540 fputs("if (length($x2m)>0) {print \" $x2m\";} else {print \" \", 0.5*($x2s+$x2e);}\n",
542 fputs("if (length($y2m)>0) {print \" $y2m\";} else {print \" \", 0.5*($y2s+$y2e);}\n",
544 fputs("print \"\\n\"\n",
548 fputs("};\n", gpoutfile);
552 fputs("}\n", gpoutfile);
554 fputs("proc gnuplot_plotarea {} {\n", 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);
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",
570 fputs("if {([llength [info commands user_gnuplot_coordinates]])} {\n",
572 fputs("set id [$win find withtag current]\n",
574 fputs("user_gnuplot_coordinates $win $id $x1s $y1s $x2s $y2s $x1e $y1e $x2e $y2e $x1m $y1m $x2m $y2m\n",
576 fputs("} else {\n", gpoutfile);
577 fputs("if {[string length $x1m]>0} {puts -nonewline \" $x1m\"} else {puts -nonewline \" [expr 0.5*($x1s+$x1e)]\"}\n",
579 fputs("if {[string length $y1m]>0} {puts -nonewline \" $y1m\"} else {puts -nonewline \" [expr 0.5*($y1s+$y1e)]\"}\n",
581 fputs("if {[string length $x2m]>0} {puts -nonewline \" $x2m\"} else {puts -nonewline \" [expr 0.5*($x2s+$x2e)]\"}\n",
583 fputs("if {[string length $y2m]>0} {puts \" $y2m\"} else {puts \" [expr 0.5*($y2s+$y2e)]\"}\n",
585 fputs("}\n", gpoutfile);
586 fputs("}\n", gpoutfile);
593 #endif /* TERM_BODY */
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)
607 #define LAST_TERM tkcanvas
609 #endif /* TERM_TABLE */
610 #endif /* TERM_PROTO_ONLY */
615 "?commands set terminal tkcanvas",
616 "?set terminal tkcanvas",
617 "?set term tkcanvas",
618 "?terminal 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",
625 " gnuplot> set term tkcanvas {perltk} {interactive}",
626 " gnuplot> set output 'plot.file'",
628 " After invoking \"wish\", execute the following sequence of Tcl/Tk commands:",
630 " % source plot.file",
635 " Or, for Perl/Tk use a program like this:",
638 " my $top = MainWindow->new;",
639 " my $c = $top->Canvas->pack;",
640 " my $gnuplot = do \"plot.pl\";",
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.",
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.",
663 " The current version of `tkcanvas` supports neither `multiplot` nor `replot`."