]> cvs.zerfleddert.de Git - micropolis/blob - src/tk/library/demos/mkPlot.tcl
Import Micropolis from http://www.donhopkins.com/home/micropolis/
[micropolis] / src / tk / library / demos / mkPlot.tcl
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 }
Impressum, Datenschutz