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     ! 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.