Return to mkPlot.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tk / library / demos

Annotation of micropolis/src/tk/library/demos/mkPlot.tcl, revision 1.1.1.1

1.1       root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.