Annotation of OpenXM_contrib/gnuplot/term/tkcanvas.trm, Revision 1.1.1.2
1.1 maekawa 1: /*
1.1.1.2 ! maekawa 2: * $Id: tkcanvas.trm,v 1.6.2.3 1999/10/19 16:00:51 lhecking Exp $
1.1 maekawa 3: *
4: */
5:
6: /* GNUPLOT - tkcanvas.trm */
7:
8: /*[
9: * Copyright 1990 - 1993, 1998
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 (info-gnuplot@dartmouth.edu).
53: *
54: */
55:
56: /*
57: * adapted to the new terminal layout by Alex Woo (Sept. 1996)
58: */
59:
1.1.1.2 ! maekawa 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: * if 'perltk' is chosen, perl code is produced, otherwise tcl code.
! 68: * Thomas Sefzick, May 1999, t.sefzick@fz-juelich.de
! 69: *
! 70: * scale plot to fit into the actual size of the canvas as reported by
! 71: * the window manager (the canvas itself doesn't report its real size).
! 72: * Matt Willis, October 1999, mattbwillis@my-deja.com
! 73: */
! 74:
1.1 maekawa 75: #include "driver.h"
76:
77: #ifdef TERM_REGISTER
78: register_term(tkcanvas)
79: #endif
80:
81: #ifdef TERM_PROTO
1.1.1.2 ! maekawa 82: TERM_PUBLIC void TK_options __PROTO((void));
1.1 maekawa 83: TERM_PUBLIC void TK_init __PROTO((void));
84: TERM_PUBLIC void TK_graphics __PROTO((void));
85: TERM_PUBLIC void TK_text __PROTO((void));
86: TERM_PUBLIC void TK_linetype __PROTO((int linetype));
87: TERM_PUBLIC void TK_move __PROTO((unsigned int x, unsigned int y));
88: TERM_PUBLIC void TK_vector __PROTO((unsigned int x, unsigned int y));
89: TERM_PUBLIC void TK_put_text __PROTO((unsigned int x, unsigned int y, char *str));
90: TERM_PUBLIC void TK_reset __PROTO((void));
1.1.1.2 ! maekawa 91: TERM_PUBLIC int TK_justify_text __PROTO((enum JUSTIFY));
! 92: TERM_PUBLIC int TK_set_font __PROTO((char *font));
! 93: TERM_PUBLIC void TK_linewidth __PROTO((double linewidth));
1.1 maekawa 94:
95: #define TK_XMAX 1000
96: #define TK_YMAX 1000
97:
98: #define TK_XLAST (TK_XMAX - 1)
99: #define TK_YLAST (TK_XMAX - 1)
100:
101: #define TK_VCHAR (25) /* double actual height of characters */
102: #define TK_HCHAR (16) /* actual width including spacing */
103: #define TK_VTIC (18)
104: #define TK_HTIC (18)
105: #endif /* TERM_PROTO */
106:
107: #ifndef TERM_PROTO_ONLY
108: #ifdef TERM_BODY
109:
1.1.1.2 ! maekawa 110: /* plot2d.c */
! 111: extern double min_array[], max_array[], base_array[], log_base_array[];
! 112: extern TBOOLEAN log_array[];
! 113: /* graphics.c */
! 114: extern int xleft, xright, ybot, ytop;
! 115: extern TBOOLEAN is_3d_plot;
! 116:
! 117: /* static int tk_angle = 0; unused, for now */
1.1 maekawa 118: static int tk_lastx;
119: static int tk_lasty;
120: static int tk_color = 0;
1.1.1.2 ! maekawa 121: static char tk_anchor[7] = "w";
! 122: static double tk_linewidth = 1.0;
! 123: static int tk_perl = 0;
! 124: static int tk_interactive = 0;
! 125: static char *tk_colors[] = {
! 126: "black", "gray", "red", "blue", "green", "brown", "magenta", "cyan"
! 127: };
1.1 maekawa 128:
1.1.1.2 ! maekawa 129: TERM_PUBLIC void
! 130: TK_options()
1.1 maekawa 131: {
1.1.1.2 ! maekawa 132: tk_perl = 0;
! 133: tk_interactive = 0;
1.1 maekawa 134:
1.1.1.2 ! maekawa 135: if (!END_OF_COMMAND) {
! 136: if (almost_equals(c_token, "p$erltk")) {
! 137: tk_perl = 1;
! 138: c_token++;
! 139: }
! 140: if (almost_equals(c_token, "i$nteractive")) {
! 141: tk_interactive = 1;
! 142: c_token++;
! 143: }
! 144: }
! 145:
! 146: sprintf(term_options, "%s %s",
! 147: tk_perl ? "perltk" : "",
! 148: tk_interactive ? "interactive" : "");
1.1 maekawa 149: }
150:
1.1.1.2 ! maekawa 151: TERM_PUBLIC void
! 152: TK_init()
1.1 maekawa 153: {
154: }
155:
1.1.1.2 ! maekawa 156: TERM_PUBLIC void
! 157: TK_graphics()
! 158: {
! 159: /*
! 160: * the resulting tcl or perl code takes the actual width and height
! 161: * of the defined canvas and scales the plot to fit.
! 162: * => NOTE: this makes 'set size' useless !!!
! 163: * unless the original width and height is taken into account
! 164: * by some tcl or perl code, that's why the 'gnuplot_plotarea' and
! 165: * 'gnuplot_axisranges' procedures are supplied.
! 166: */
! 167: if (tk_perl) {
! 168: fputs("\
! 169: sub gnuplot {\n\
! 170: my($can) = @_;\n\
! 171: $can->delete('all');\n\
! 172: my $cmx = ($can->configure(-width))[4];\n\
! 173: my $cmy = ($can->configure(-height))[4];\n\
! 174: my $cmx = $can->width - 2 * $can->cget(-border);\n\
! 175: if ($cmx <= 1) {\n$cmx = ($can->cget(-width));\n}\n\
! 176: my $cmy = $can->height - 2 * $can->cget(-border);\n\
! 177: if ($cmy <= 1) {\n$cmy = ($can->cget(-height));\n}\n",
! 178: gpoutfile);
! 179: } else {
! 180: fputs("\
! 181: proc gnuplot can {\n\
! 182: $can delete all\n\
! 183: set cmx [expr [winfo width $can]-2*[$can cget -border]]\n\
! 184: if {$cmx <= 1} {set cmx [$can cget -width]}\n\
! 185: set cmy [expr [winfo height $can]-2*[$can cget -border]]\n\
! 186: if {$cmy <= 1} {set cmy [$can cget -height]}\n",
! 187: gpoutfile);
! 188: }
! 189: tk_lastx = tk_lasty = tk_color = 0;
! 190: }
1.1 maekawa 191:
1.1.1.2 ! maekawa 192: TERM_PUBLIC void
! 193: TK_reset()
1.1 maekawa 194: {
195: }
196:
1.1.1.2 ! maekawa 197: TERM_PUBLIC void
! 198: TK_linetype(linetype)
1.1 maekawa 199: int linetype;
200: {
201: tk_color = (linetype + 2) & 7;
202: }
203:
1.1.1.2 ! maekawa 204: TERM_PUBLIC void
! 205: TK_linewidth(linewidth)
! 206: double linewidth;
! 207: {
! 208: tk_linewidth = linewidth;
! 209: }
! 210:
! 211: TERM_PUBLIC void
! 212: TK_move(x, y)
1.1 maekawa 213: unsigned int x, y;
214: {
215: tk_lastx = x;
216: tk_lasty = 1000 - y;
217: }
218:
1.1.1.2 ! maekawa 219: #define TK_REAL_VALUE(value,axis) \
! 220: (log_array[axis])\
! 221: ?pow(base_array[axis],min_array[axis]+value*(max_array[axis]-min_array[axis]))\
! 222: :min_array[axis]+value*(max_array[axis]-min_array[axis])
! 223:
! 224: #define TK_X_VALUE(value) \
! 225: (double)(value-xleft)/(double)(xright-xleft)
1.1 maekawa 226:
1.1.1.2 ! maekawa 227: #define TK_Y_VALUE(value) \
! 228: (double)((TK_YMAX-value)-ybot)/(double)(ytop-ybot)
! 229:
! 230: TERM_PUBLIC void
! 231: TK_vector(x, y)
1.1 maekawa 232: unsigned int x, y;
233: {
1.1.1.2 ! maekawa 234: /*
! 235: * this is the 1st part of the wrapper around the 'create line' command
! 236: * used to bind some actions to a line segment:
! 237: * bind {
! 238: * normal create line command
! 239: * } gnuplot_xy(some coordinates)
! 240: */
! 241: if (tk_interactive && !is_3d_plot) {
! 242: if (tk_perl)
! 243: fprintf(gpoutfile, "$can->bind(");
! 244: else
! 245: fprintf(gpoutfile, "$can bind [\n");
! 246: }
! 247: /*
! 248: * end of 1st part of wrapper
! 249: */
1.1 maekawa 250: y = 1000 - y;
1.1.1.2 ! maekawa 251: /*
! 252: * here is the basic well-known command for plotting a line segment
! 253: */
! 254: if (tk_perl) {
! 255: fprintf(gpoutfile,"\
! 256: $can->createLine(\
! 257: $cmx * %d / 1000, \
! 258: $cmy * %d / 1000, \
! 259: $cmx * %d / 1000, \
! 260: $cmy * %d / 1000, -fill => q{%s}, -width => %f, -capstyle => q{round})",
! 261: tk_lastx, tk_lasty, x, y, tk_colors[tk_color], tk_linewidth);
! 262: } else {
! 263: fprintf(gpoutfile,"\
! 264: $can create line \
! 265: [expr $cmx * %d /1000] \
! 266: [expr $cmy * %d /1000] \
! 267: [expr $cmx * %d /1000] \
! 268: [expr $cmy * %d /1000] -fill %s -width %f -capstyle round\n",
! 269: tk_lastx, tk_lasty, x, y, tk_colors[tk_color], tk_linewidth);
! 270: }
! 271:
! 272: /*
! 273: * this is the 2nd part of the wrapper around the 'create line'
! 274: * command, it generates a mechanism which calls 'gnuplot_xy' for
! 275: * the line segment pointed to by the mouse cursor when a mouse
! 276: * button is pressed
! 277: */
! 278: if (tk_interactive && !is_3d_plot) {
! 279: if (tk_perl) {
! 280: /* Ev('W') not needed here, supplied anyhow, WHY ??? */
! 281: fprintf(gpoutfile,"\
! 282: , '<Button>' => \
! 283: [\\&gnuplot_xy, %f, %f, %f, %f, %f, %f, %f, %f,",
! 284: TK_REAL_VALUE(TK_X_VALUE(tk_lastx), FIRST_X_AXIS),
! 285: TK_REAL_VALUE(TK_Y_VALUE(tk_lasty), FIRST_Y_AXIS),
! 286: TK_REAL_VALUE(TK_X_VALUE(tk_lastx), SECOND_X_AXIS),
! 287: TK_REAL_VALUE(TK_Y_VALUE(tk_lasty), SECOND_Y_AXIS),
! 288: TK_REAL_VALUE(TK_X_VALUE(x), FIRST_X_AXIS),
! 289: TK_REAL_VALUE(TK_Y_VALUE(y), FIRST_Y_AXIS),
! 290: TK_REAL_VALUE(TK_X_VALUE(x), SECOND_X_AXIS),
! 291: TK_REAL_VALUE(TK_Y_VALUE(y), SECOND_Y_AXIS));
! 292: if (log_array[FIRST_X_AXIS]) {
! 293: fprintf(gpoutfile, " %f,",
! 294: TK_REAL_VALUE(TK_X_VALUE(0.5 * (x + tk_lastx)), FIRST_X_AXIS));
! 295: } else {
! 296: fprintf(gpoutfile, " \"\",");
! 297: }
! 298: if (log_array[FIRST_Y_AXIS]) {
! 299: fprintf(gpoutfile, " %f,",
! 300: TK_REAL_VALUE(TK_Y_VALUE(0.5 * (y + tk_lasty)), FIRST_Y_AXIS));
! 301: } else {
! 302: fprintf(gpoutfile, " \"\",");
! 303: }
! 304: if (log_array[SECOND_X_AXIS]) {
! 305: fprintf(gpoutfile, " %f,",
! 306: TK_REAL_VALUE(TK_X_VALUE(0.5 * (x + tk_lastx)), SECOND_X_AXIS));
! 307: } else {
! 308: fprintf(gpoutfile, " \"\",");
! 309: }
! 310: if (log_array[SECOND_Y_AXIS]) {
! 311: fprintf(gpoutfile, " %f",
! 312: TK_REAL_VALUE(TK_Y_VALUE(0.5 * (y + tk_lasty)), SECOND_Y_AXIS));
! 313: } else {
! 314: fprintf(gpoutfile, " \"\"");
! 315: }
! 316: fprintf(gpoutfile, "]);\n");
! 317: } else {
! 318: fprintf(gpoutfile,"\
! 319: ] <Button> \
! 320: \"gnuplot_xy %%W %f %f %f %f %f %f %f %f",
! 321: TK_REAL_VALUE(TK_X_VALUE(tk_lastx), FIRST_X_AXIS),
! 322: TK_REAL_VALUE(TK_Y_VALUE(tk_lasty), FIRST_Y_AXIS),
! 323: TK_REAL_VALUE(TK_X_VALUE(tk_lastx), SECOND_X_AXIS),
! 324: TK_REAL_VALUE(TK_Y_VALUE(tk_lasty), SECOND_Y_AXIS),
! 325: TK_REAL_VALUE(TK_X_VALUE(x), FIRST_X_AXIS),
! 326: TK_REAL_VALUE(TK_Y_VALUE(y), FIRST_Y_AXIS),
! 327: TK_REAL_VALUE(TK_X_VALUE(x), SECOND_X_AXIS),
! 328: TK_REAL_VALUE(TK_Y_VALUE(y), SECOND_Y_AXIS));
! 329: if (log_array[FIRST_X_AXIS]) {
! 330: fprintf(gpoutfile, " %f",
! 331: TK_REAL_VALUE(TK_X_VALUE(0.5 * (x + tk_lastx)), FIRST_X_AXIS));
! 332: } else {
! 333: fprintf(gpoutfile, " {}");
! 334: }
! 335: if (log_array[FIRST_Y_AXIS]) {
! 336: fprintf(gpoutfile, " %f",
! 337: TK_REAL_VALUE(TK_Y_VALUE(0.5 * (y + tk_lasty)), FIRST_Y_AXIS));
! 338: } else {
! 339: fprintf(gpoutfile, " {}");
! 340: }
! 341: if (log_array[SECOND_X_AXIS]) {
! 342: fprintf(gpoutfile, " %f",
! 343: TK_REAL_VALUE(TK_X_VALUE(0.5 * (x + tk_lastx)), SECOND_X_AXIS));
! 344: } else {
! 345: fprintf(gpoutfile, " {}");
! 346: }
! 347: if (log_array[SECOND_Y_AXIS]) {
! 348: fprintf(gpoutfile, " %f",
! 349: TK_REAL_VALUE(TK_Y_VALUE(0.5 * (y + tk_lasty)), SECOND_Y_AXIS));
! 350: } else {
! 351: fprintf(gpoutfile, " {}");
! 352: }
! 353: fprintf(gpoutfile, "\"\n");
! 354: }
! 355: } else {
! 356: if (tk_perl) {
! 357: fprintf(gpoutfile, ";\n");
! 358: }
! 359: }
! 360: /*
! 361: * end of the wrapper
! 362: */
1.1 maekawa 363: tk_lastx = x;
364: tk_lasty = y;
365: }
366:
1.1.1.2 ! maekawa 367: #undef TK_REAL_VALUE
! 368: #undef TK_X_VALUE
! 369: #undef TK_Y_VALUE
1.1 maekawa 370:
1.1.1.2 ! maekawa 371: TERM_PUBLIC void
! 372: TK_put_text(x, y, str)
1.1 maekawa 373: unsigned int x, y;
374: char *str;
375: {
376: y = 1000 - y;
1.1.1.2 ! maekawa 377: if (tk_perl) {
! 378: fprintf(gpoutfile,"\
! 379: $can->createText(\
! 380: $cmx * %d / 1000, \
! 381: $cmy * %d / 1000, \
! 382: -text => q{%s}, -fill => q{%s}, -anchor => '%s', \
! 383: (defined $font ? (-font => $font) : ()));\n",
! 384: x, y, str, tk_colors[tk_color], tk_anchor);
! 385: } else {
! 386: fprintf(gpoutfile,"\
! 387: eval $can create text \
! 388: [expr $cmx * %d /1000] \
! 389: [expr $cmy * %d /1000] \
! 390: -text \\{%s\\} -fill %s -anchor %s\
! 391: [expr [info exists font]?\"-font \\$font\":{}]\n",
! 392: x, y, str, tk_colors[tk_color], tk_anchor);
! 393: }
1.1 maekawa 394: }
395:
1.1.1.2 ! maekawa 396: TERM_PUBLIC int
! 397: TK_justify_text(anchor)
! 398: enum JUSTIFY anchor;
1.1 maekawa 399: {
1.1.1.2 ! maekawa 400: int return_value;
! 401:
! 402: switch (anchor) {
! 403: case RIGHT:
! 404: strcpy(tk_anchor, "e");
! 405: return_value = TRUE;
! 406: break;
! 407: case CENTRE:
! 408: strcpy(tk_anchor, "center");
! 409: return_value = TRUE;
! 410: break;
! 411: case LEFT:
! 412: strcpy(tk_anchor, "w");
! 413: return_value = TRUE;
! 414: break;
! 415: default:
! 416: strcpy(tk_anchor, "w");
! 417: return_value = FALSE;
! 418: }
! 419: return return_value;
! 420: }
! 421:
! 422: TERM_PUBLIC int
! 423: TK_set_font(font)
! 424: char *font;
! 425: {
! 426: if (!font || *font == NUL) {
! 427: if (tk_perl)
! 428: fputs("undef $font;\n", gpoutfile);
! 429: else
! 430: fputs("catch {unset $font}\n", gpoutfile);
! 431: } else {
! 432: char *name;
! 433: int size = 0;
! 434: size_t sep = strcspn(font, ",");
! 435:
! 436: name = malloc(sep + 1);
! 437: if (!name)
! 438: return FALSE;
! 439: strncpy(name, font, sep);
! 440: name[sep] = NUL;
! 441: if (sep < strlen(font))
! 442: sscanf(&(font[sep + 1]), "%d", &size);
! 443: if (tk_perl) {
! 444: fprintf(gpoutfile,"\
! 445: if ($can->can('fontCreate')) {\n\
! 446: $font = $can->fontCreate(-family => q{%s}",
! 447: name);
! 448: if (size)
! 449: fprintf(gpoutfile, ", -size => %d", size);
! 450: fputs(");\n}\n", gpoutfile);
! 451: } else {
! 452: fprintf(gpoutfile, "set font [font create -family %s", name);
! 453: if (size)
! 454: fprintf(gpoutfile, " -size %d", size);
! 455: fputs("]\n", gpoutfile);
! 456: }
! 457: free(name);
! 458: }
! 459: return TRUE;
1.1 maekawa 460: }
461:
1.1.1.2 ! maekawa 462: TERM_PUBLIC void
! 463: TK_text()
! 464: {
! 465: /*
! 466: * when switching back to text mode some procedures are generated which
! 467: * return important information about plotarea size and axis ranges:
! 468: * 'gnuplot_plotarea' returns the plotarea size in tkcanvas units
! 469: * 'gnuplot_axisranges' returns the min. and max. values of the axis
! 470: * these are essentially needed to set the size of the canvas when the
! 471: * axis scaling is important.
! 472: * moreover, a procedure 'gnuplot_xy' is created which contains the
! 473: * actions bound to line segments (see the above 'TK_vector' code):
! 474: * if the user has defined a procedure named 'user_gnuplot_coordinates'
! 475: * then 'gnuplot_xy' calls this procedure, otherwise is writes the
! 476: * coordinates of the line segment the mouse cursor is pointing to
! 477: * to standard output.
! 478: */
! 479: if (tk_perl) {
! 480: fputs("};\n", gpoutfile);
! 481: if (!is_3d_plot) {
! 482: fputs("sub gnuplot_plotarea {\n", gpoutfile);
! 483: fprintf(gpoutfile,
! 484: "return (%d, %d, %d, %d);\n",
! 485: xleft, xright, 1000 - ytop, 1000 - ybot);
! 486: fputs("};\n", gpoutfile);
! 487: fputs("sub gnuplot_axisranges {\n", gpoutfile);
! 488: fprintf(gpoutfile,
! 489: "return (%f, %f, %f, %f, %f, %f, %f, %f);\n",
! 490: min_array[FIRST_X_AXIS], max_array[FIRST_X_AXIS],
! 491: min_array[FIRST_Y_AXIS], max_array[FIRST_Y_AXIS],
! 492: min_array[SECOND_X_AXIS], max_array[SECOND_X_AXIS],
! 493: min_array[SECOND_Y_AXIS], max_array[SECOND_Y_AXIS]);
! 494: fputs("};\n", gpoutfile);
! 495: if (tk_interactive) {
! 496: fputs("sub gnuplot_xy {\n",
! 497: gpoutfile);
! 498: fputs("my ($win, $x1s, $y1s, $x2s, $y2s, $x1e, $y1e, $x2e, $y2e, $x1m, $y1m, $x2m, $y2m) = @_;\n",
! 499: gpoutfile);
! 500: fputs("if (defined &user_gnuplot_coordinates) {\n",
! 501: gpoutfile);
! 502: fputs("my $id = $win->find('withtag', 'current');\n",
! 503: gpoutfile);
! 504: fputs("user_gnuplot_coordinates $win, $id, $x1s, $y1s, $x2s, $y2s, $x1e, $y1e, $x2e, $y2e, $x1m, $y1m, $x2m, $y2m\n",
! 505: gpoutfile);
! 506: fputs("} else {\n",
! 507: gpoutfile);
! 508: fputs("if (length($x1m)>0) {print \" $x1m\";} else {print \" \", 0.5*($x1s+$x1e);}\n",
! 509: gpoutfile);
! 510: fputs("if (length($y1m)>0) {print \" $y1m\";} else {print \" \", 0.5*($y1s+$y1e);}\n",
! 511: gpoutfile);
! 512: fputs("if (length($x2m)>0) {print \" $x2m\";} else {print \" \", 0.5*($x2s+$x2e);}\n",
! 513: gpoutfile);
! 514: fputs("if (length($y2m)>0) {print \" $y2m\";} else {print \" \", 0.5*($y2s+$y2e);}\n",
! 515: gpoutfile);
! 516: fputs("print \"\\n\"\n",
! 517: gpoutfile);
! 518: fputs("}\n",
! 519: gpoutfile);
! 520: fputs("};\n", gpoutfile);
! 521: }
! 522: }
! 523: } else {
! 524: fputs("}\n", gpoutfile);
! 525: if (!is_3d_plot) {
! 526: fputs("proc gnuplot_plotarea {} {\n", gpoutfile);
! 527: fprintf(gpoutfile,
! 528: "return {%d %d %d %d}\n",
! 529: xleft, xright, 1000 - ytop, 1000 - ybot);
! 530: fputs("}\n", gpoutfile);
! 531: fputs("proc gnuplot_axisranges {} {\n", gpoutfile);
! 532: fprintf(gpoutfile,
! 533: "return {%f %f %f %f %f %f %f %f}\n",
! 534: min_array[FIRST_X_AXIS], max_array[FIRST_X_AXIS],
! 535: min_array[FIRST_Y_AXIS], max_array[FIRST_Y_AXIS],
! 536: min_array[SECOND_X_AXIS], max_array[SECOND_X_AXIS],
! 537: min_array[SECOND_Y_AXIS], max_array[SECOND_Y_AXIS]);
! 538: fputs("}\n", gpoutfile);
! 539: if (tk_interactive) {
! 540: fputs("proc gnuplot_xy {win x1s y1s x2s y2s x1e y1e x2e y2e x1m y1m x2m y2m} {\n",
! 541: gpoutfile);
! 542: fputs("if {([llength [info commands user_gnuplot_coordinates]])} {\n",
! 543: gpoutfile);
! 544: fputs("set id [$win find withtag current]\n",
! 545: gpoutfile);
! 546: fputs("user_gnuplot_coordinates $win $id $x1s $y1s $x2s $y2s $x1e $y1e $x2e $y2e $x1m $y1m $x2m $y2m\n",
! 547: gpoutfile);
! 548: fputs("} else {\n", gpoutfile);
! 549: fputs("if {[string length $x1m]>0} {puts -nonewline \" $x1m\"} else {puts -nonewline \" [expr 0.5*($x1s+$x1e)]\"}\n",
! 550: gpoutfile);
! 551: fputs("if {[string length $y1m]>0} {puts -nonewline \" $y1m\"} else {puts -nonewline \" [expr 0.5*($y1s+$y1e)]\"}\n",
! 552: gpoutfile);
! 553: fputs("if {[string length $x2m]>0} {puts -nonewline \" $x2m\"} else {puts -nonewline \" [expr 0.5*($x2s+$x2e)]\"}\n",
! 554: gpoutfile);
! 555: fputs("if {[string length $y2m]>0} {puts \" $y2m\"} else {puts \" [expr 0.5*($y2s+$y2e)]\"}\n",
! 556: gpoutfile);
! 557: fputs("}\n", gpoutfile);
! 558: fputs("}\n", gpoutfile);
! 559: }
! 560: }
! 561: }
! 562: fflush(gpoutfile);
! 563: }
1.1 maekawa 564:
565: #endif /* TERM_BODY */
566:
567: #ifdef TERM_TABLE
1.1.1.2 ! maekawa 568:
1.1 maekawa 569: TERM_TABLE_START(tkcanvas)
1.1.1.2 ! maekawa 570: "tkcanvas", "Tk/Tcl canvas widget [perltk] [interactive]",
1.1 maekawa 571: TK_XMAX, TK_YMAX, TK_VCHAR, TK_HCHAR,
1.1.1.2 ! maekawa 572: TK_VTIC, TK_HTIC, TK_options, TK_init, TK_reset,
1.1 maekawa 573: TK_text, null_scale, TK_graphics, TK_move, TK_vector,
574: TK_linetype, TK_put_text, null_text_angle,
1.1.1.2 ! maekawa 575: TK_justify_text, do_point, do_arrow, TK_set_font,
! 576: NULL, 0, NULL, NULL, NULL, TK_linewidth
1.1 maekawa 577: TERM_TABLE_END(tkcanvas)
578: #undef LAST_TERM
579: #define LAST_TERM tkcanvas
580:
581: #endif /* TERM_TABLE */
582: #endif /* TERM_PROTO_ONLY */
583:
584: #ifdef TERM_HELP
585: START_HELP(tkcanvas)
586: "1 tkcanvas",
587: "?commands set terminal tkcanvas",
588: "?set terminal tkcanvas",
589: "?set term tkcanvas",
590: "?terminal tkcanvas",
591: "?term tkcanvas",
592: "?tkcanvas",
1.1.1.2 ! maekawa 593: " This terminal driver generates Tk canvas widget commands based on Tcl/Tk",
! 594: " (default) or Perl. To use it, rebuild `gnuplot` (after uncommenting or",
! 595: " inserting the appropriate line in \"term.h\"), then",
1.1 maekawa 596: "",
1.1.1.2 ! maekawa 597: " gnuplot> set term tkcanvas {perltk} {interactive}",
1.1 maekawa 598: " gnuplot> set output 'plot.file'",
599: "",
1.1.1.2 ! maekawa 600: " After invoking \"wish\", execute the following sequence of Tcl/Tk commands:",
1.1 maekawa 601: "",
602: " % source plot.file",
603: " % canvas .c",
604: " % pack .c",
605: " % gnuplot .c",
606: "",
1.1.1.2 ! maekawa 607: " Or, for Perl/Tk use a program like this:",
! 608: "",
! 609: " use Tk;",
! 610: " my $top = MainWindow->new;",
! 611: " my $c = $top->Canvas;",
! 612: " $c->pack();",
! 613: " do \"plot.pl\";",
! 614: " gnuplot->($c);",
! 615: " MainLoop;",
! 616: "",
! 617: " The code generated by `gnuplot` creates a procedure called \"gnuplot\"",
! 618: " that takes the name of a canvas as its argument. When the procedure is",
1.1 maekawa 619: " called, it clears the canvas, finds the size of the canvas and draws the plot",
620: " in it, scaled to fit.",
1.1.1.2 ! maekawa 621: "",
! 622: " For 2-dimensional plotting (`plot`) two additional procedures are defined:",
! 623: " \"gnuplot_plotarea\" will return a list containing the borders of the plotting",
! 624: " area \"xleft, xright, ytop, ybot\" in canvas screen coordinates, while the ranges",
! 625: " of the two axes \"x1min, x1max, y1min, y1max, x2min, x2max, y2min, y2max\" in plot",
! 626: " coordinates can be obtained calling \"gnuplot_axisranges\".",
! 627: " If the \"interactive\" option is specified, mouse clicking on a line segment",
! 628: " will print the coordinates of its midpoint to stdout. Advanced actions",
! 629: " can happen instead if the user supplies a procedure named",
! 630: " \"user_gnuplot_coordinates\", which takes the following arguments:",
! 631: " \"win id x1s y1s x2s y2s x1e y1e x2e y2e x1m y1m x2m y2m\",",
! 632: " the name of the canvas and the id of the line segment followed by the",
! 633: " coordinates of its start and end point in the two possible axis ranges; the",
! 634: " coordinates of the midpoint are only filled for logarithmic axes.",
1.1 maekawa 635: "",
636: " The current version of `tkcanvas` supports neither `multiplot` nor `replot`."
637: END_HELP(tkcanvas)
638: #endif
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>