| 1 | # mkPlot w |
| 2 | # |
| 3 | # Create a top-level window containing a canvas displaying a simple |
| 4 | # graph with data points that can be moved interactively. |
| 5 | # |
| 6 | # Arguments: |
| 7 | # w - Name to use for new top-level window. |
| 8 | |
| 9 | proc mkPlot {{w .plot}} { |
| 10 | catch {destroy $w} |
| 11 | toplevel $w |
| 12 | dpos $w |
| 13 | wm title $w "Plot Demonstration" |
| 14 | wm iconname $w "Plot" |
| 15 | set c $w.c |
| 16 | |
| 17 | frame $w.frame1 -relief raised -bd 2 |
| 18 | canvas $c -relief raised -width 450 -height 300 |
| 19 | button $w.ok -text "OK" -command "destroy $w" |
| 20 | pack append $w $w.frame1 {top fill} $w.c {expand fill} \ |
| 21 | $w.ok {bottom pady 10 frame center} |
| 22 | message $w.frame1.m -font -Adobe-Times-Medium-R-Normal-*-180-* -aspect 300 \ |
| 23 | -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." |
| 24 | pack append $w.frame1 $w.frame1.m {frame center} |
| 25 | |
| 26 | set font -Adobe-helvetica-medium-r-*-180-* |
| 27 | |
| 28 | $c create line 100 250 400 250 -width 2 |
| 29 | $c create line 100 250 100 50 -width 2 |
| 30 | $c create text 225 20 -text "A Simple Plot" -font $font -fill brown |
| 31 | |
| 32 | for {set i 0} {$i <= 10} {incr i} { |
| 33 | set x [expr {100 + ($i*30)}] |
| 34 | $c create line $x 250 $x 245 -width 2 |
| 35 | $c create text $x 254 -text [expr 10*$i] -anchor n -font $font |
| 36 | } |
| 37 | for {set i 0} {$i <= 5} {incr i} { |
| 38 | set y [expr {250 - ($i*40)}] |
| 39 | $c create line 100 $y 105 $y -width 2 |
| 40 | $c create text 96 $y -text [expr $i*50].0 -anchor e -font $font |
| 41 | } |
| 42 | |
| 43 | foreach point {{12 56} {20 94} {33 98} {32 120} {61 180} |
| 44 | {75 160} {98 223}} { |
| 45 | set x [expr {100 + (3*[lindex $point 0])}] |
| 46 | set y [expr {250 - (4*[lindex $point 1])/5}] |
| 47 | set item [$c create oval [expr $x-6] [expr $y-6] \ |
| 48 | [expr $x+6] [expr $y+6] -width 1 -outline black \ |
| 49 | -fill SkyBlue2] |
| 50 | $c addtag point withtag $item |
| 51 | } |
| 52 | |
| 53 | $c bind point <Any-Enter> "$c itemconfig current -fill red" |
| 54 | $c bind point <Any-Leave> "$c itemconfig current -fill SkyBlue2" |
| 55 | $c bind point <1> "plotDown $c %x %y" |
| 56 | $c bind point <ButtonRelease-1> "$c dtag selected" |
| 57 | bind $c <B1-Motion> "plotMove $c %x %y" |
| 58 | } |
| 59 | |
| 60 | set plot(lastX) 0 |
| 61 | set plot(lastY) 0 |
| 62 | |
| 63 | proc plotDown {w x y} { |
| 64 | global plot |
| 65 | $w dtag selected |
| 66 | $w addtag selected withtag current |
| 67 | $w raise current |
| 68 | set plot(lastX) $x |
| 69 | set plot(lastY) $y |
| 70 | } |
| 71 | |
| 72 | proc plotMove {w x y} { |
| 73 | global plot |
| 74 | $w move selected [expr $x-$plot(lastX)] [expr $y-$plot(lastY)] |
| 75 | set plot(lastX) $x |
| 76 | set plot(lastY) $y |
| 77 | } |