1 | # plot.tcl -- |
---|
2 | # |
---|
3 | # This demonstration script creates a canvas widget showing a 2-D |
---|
4 | # plot with data points that can be dragged with the mouse. |
---|
5 | # |
---|
6 | # RCS: @(#) $Id: plot.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $ |
---|
7 | |
---|
8 | if {![info exists widgetDemo]} { |
---|
9 | error "This script should be run from the \"widget\" demo." |
---|
10 | } |
---|
11 | |
---|
12 | set w .plot |
---|
13 | catch {destroy $w} |
---|
14 | toplevel $w |
---|
15 | wm title $w "Plot Demonstration" |
---|
16 | wm iconname $w "Plot" |
---|
17 | positionWindow $w |
---|
18 | set c $w.c |
---|
19 | |
---|
20 | label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget containing a simple 2-dimensional plot. You can doctor the data by dragging any of the points with mouse button 1." |
---|
21 | pack $w.msg -side top |
---|
22 | |
---|
23 | frame $w.buttons |
---|
24 | pack $w.buttons -side bottom -fill x -pady 2m |
---|
25 | button $w.buttons.dismiss -text Dismiss -command "destroy $w" |
---|
26 | button $w.buttons.code -text "See Code" -command "showCode $w" |
---|
27 | pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 |
---|
28 | |
---|
29 | canvas $c -relief raised -width 450 -height 300 |
---|
30 | pack $w.c -side top -fill x |
---|
31 | |
---|
32 | set plotFont {Helvetica 18} |
---|
33 | |
---|
34 | $c create line 100 250 400 250 -width 2 |
---|
35 | $c create line 100 250 100 50 -width 2 |
---|
36 | $c create text 225 20 -text "A Simple Plot" -font $plotFont -fill brown |
---|
37 | |
---|
38 | for {set i 0} {$i <= 10} {incr i} { |
---|
39 | set x [expr {100 + ($i*30)}] |
---|
40 | $c create line $x 250 $x 245 -width 2 |
---|
41 | $c create text $x 254 -text [expr 10*$i] -anchor n -font $plotFont |
---|
42 | } |
---|
43 | for {set i 0} {$i <= 5} {incr i} { |
---|
44 | set y [expr {250 - ($i*40)}] |
---|
45 | $c create line 100 $y 105 $y -width 2 |
---|
46 | $c create text 96 $y -text [expr $i*50].0 -anchor e -font $plotFont |
---|
47 | } |
---|
48 | |
---|
49 | foreach point {{12 56} {20 94} {33 98} {32 120} {61 180} |
---|
50 | {75 160} {98 223}} { |
---|
51 | set x [expr {100 + (3*[lindex $point 0])}] |
---|
52 | set y [expr {250 - (4*[lindex $point 1])/5}] |
---|
53 | set item [$c create oval [expr $x-6] [expr $y-6] \ |
---|
54 | [expr $x+6] [expr $y+6] -width 1 -outline black \ |
---|
55 | -fill SkyBlue2] |
---|
56 | $c addtag point withtag $item |
---|
57 | } |
---|
58 | |
---|
59 | $c bind point <Any-Enter> "$c itemconfig current -fill red" |
---|
60 | $c bind point <Any-Leave> "$c itemconfig current -fill SkyBlue2" |
---|
61 | $c bind point <1> "plotDown $c %x %y" |
---|
62 | $c bind point <ButtonRelease-1> "$c dtag selected" |
---|
63 | bind $c <B1-Motion> "plotMove $c %x %y" |
---|
64 | |
---|
65 | set plot(lastX) 0 |
---|
66 | set plot(lastY) 0 |
---|
67 | |
---|
68 | # plotDown -- |
---|
69 | # This procedure is invoked when the mouse is pressed over one of the |
---|
70 | # data points. It sets up state to allow the point to be dragged. |
---|
71 | # |
---|
72 | # Arguments: |
---|
73 | # w - The canvas window. |
---|
74 | # x, y - The coordinates of the mouse press. |
---|
75 | |
---|
76 | proc plotDown {w x y} { |
---|
77 | global plot |
---|
78 | $w dtag selected |
---|
79 | $w addtag selected withtag current |
---|
80 | $w raise current |
---|
81 | set plot(lastX) $x |
---|
82 | set plot(lastY) $y |
---|
83 | } |
---|
84 | |
---|
85 | # plotMove -- |
---|
86 | # This procedure is invoked during mouse motion events. It drags the |
---|
87 | # current item. |
---|
88 | # |
---|
89 | # Arguments: |
---|
90 | # w - The canvas window. |
---|
91 | # x, y - The coordinates of the mouse. |
---|
92 | |
---|
93 | proc plotMove {w x y} { |
---|
94 | global plot |
---|
95 | $w move selected [expr $x-$plot(lastX)] [expr $y-$plot(lastY)] |
---|
96 | set plot(lastX) $x |
---|
97 | set plot(lastY) $y |
---|
98 | } |
---|