Commit | Line | Data |
---|---|---|
920dae64 AT |
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 | } |