|
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.3 2001/06/14 10:56:58 dkf 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 { |
|
50 {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223} |
|
51 } { |
|
52 set x [expr {100 + (3*[lindex $point 0])}] |
|
53 set y [expr {250 - (4*[lindex $point 1])/5}] |
|
54 set item [$c create oval [expr {$x-6}] [expr {$y-6}] \ |
|
55 [expr {$x+6}] [expr {$y+6}] -width 1 -outline black \ |
|
56 -fill SkyBlue2] |
|
57 $c addtag point withtag $item |
|
58 } |
|
59 |
|
60 $c bind point <Any-Enter> "$c itemconfig current -fill red" |
|
61 $c bind point <Any-Leave> "$c itemconfig current -fill SkyBlue2" |
|
62 $c bind point <1> "plotDown $c %x %y" |
|
63 $c bind point <ButtonRelease-1> "$c dtag selected" |
|
64 bind $c <B1-Motion> "plotMove $c %x %y" |
|
65 |
|
66 set plot(lastX) 0 |
|
67 set plot(lastY) 0 |
|
68 |
|
69 # plotDown -- |
|
70 # This procedure is invoked when the mouse is pressed over one of the |
|
71 # data points. It sets up state to allow the point to be dragged. |
|
72 # |
|
73 # Arguments: |
|
74 # w - The canvas window. |
|
75 # x, y - The coordinates of the mouse press. |
|
76 |
|
77 proc plotDown {w x y} { |
|
78 global plot |
|
79 $w dtag selected |
|
80 $w addtag selected withtag current |
|
81 $w raise current |
|
82 set plot(lastX) $x |
|
83 set plot(lastY) $y |
|
84 } |
|
85 |
|
86 # plotMove -- |
|
87 # This procedure is invoked during mouse motion events. It drags the |
|
88 # current item. |
|
89 # |
|
90 # Arguments: |
|
91 # w - The canvas window. |
|
92 # x, y - The coordinates of the mouse. |
|
93 |
|
94 proc plotMove {w x y} { |
|
95 global plot |
|
96 $w move selected [expr {$x-$plot(lastX)}] [expr {$y-$plot(lastY)}] |
|
97 set plot(lastX) $x |
|
98 set plot(lastY) $y |
|
99 } |