哪位高手会 tcl/tk编程

复制内容到剪贴板

代码:

set sample 120
set dot_per_sample 5
set width [expr $sample * $dot_per_sample]
set line_color {red blue green yellow orange}

proc plot {} {
    global data_list_array
    global log_scale
    global show_flag

    set max 0
    foreach i [array names data_list_array] {
           if {$show_flag($i)} {
                foreach data $data_list_array($i) {
                       if {$data > $max} {
                              set max $data
                       }
                  }
             }
        }
        if {$log_scale} {
            log_plot 0 $max
        } else {
             plain_plot 0 $max
        }
}
proc plain_plot {min max} {
     global data_list_array
     global height
     global width
     global sample
     global dot_per_sample
     global show_flag
     global line_color
     global log_scale

     for {set xx 1} {$max > [expr $height * $xx]} {incr xx} {
     }

     .c delete all
     set ii [expr int($xx / 10) + 1]
     for {set i $ii} {$i < $xx} {incr i $ii} {
          set y [expr $height - $i * $height / $xx]
          .c create line 0 $y $width $y
          .c create text $width $y -text [expr $i * $height] -anchor sw
      }

      foreach i [array names data_list_array] {
           if {$show_flag($i)} {
                set l [llength $data_list_array($i)]
                set line_coord {}
                for {set j 0} {$j < $l} {incr j} {
                set y [expr $height - [lindex $data_list_array($i) $j] / $xx]
                 lappend line_coord [expr $j * $dot_per_sample] $y
               }
               if {$l > 1} {
                    set color I
                       [lindex $line_color [expr $i % [llength \ $line_color]]]
                     eval".c create line $line_coord -fill $color"
                   set y [lindex $line_coord [expr [llength $line_coord] - 1]]
                   set x [lindex $line_coord [expr [llength $line_coord] - 2]]
                   .c create text $x $y -text $i -fill $color
               }
               }
              }
       }
proc log_plot {min max} {
         global data_list_array
         global height
         golbal width
         golbal sample
         golbal dot_per_sample
         golbal show_flag
          golbal line_color
        golbal log_scale

        set log_max [expr int(log10($max)) + 1]
        .c delete all
        for {set i 1} {$i < $log_max} {incr i} {
           set y [expr $height - $height * $i / $log_max]
           .c create line 0 $y $width $y
           .c create text $width $y -text "10^$i" -anchor sw
       }
        foreach i [array names data_list_array] {
           if {$show_flag($i)} {
              set l [llength $data_list_array($i)]
             set line_coord {}
              for {set j 0} {$j < $l} {incr j} {
                  set y [expr $height - $height * \
                    log10([lindex $data_list_array($i) $j] +1) / \ $log_max]
                  lappend line_coord [expr $j * $dot_per_sample] $y
                }
              if {$l >1} {
                    set color \
                      [lindex $line_color [expr $i % [llength $line_color]]]
                    eval ".c create line $line_coord -fill $color"
                 set y [lindex $line_coord [expr [llength $line_coord] - 1]]
                  set x [lindex $line_coord [expr [llength $line_coord] - 2]]
                  .c create text $x $y -text $i -fill $color
               }
              }   
           }
    }

proc entry_data {id data} {
         global data_list_array
         global show_flag
         global sample
         if {![info exists data_list_array($id)]} {
           set data_list_array($id) {}
           set show_flag($id) 1
           .mbar.show.menu add checkbutton -label $id -variable\
           show_flag($id)
           }
           lappend data_list_array($id) $data
          if {[llength $data_list_array($id)] >= $sample} {
     set data_list_array($id) [Lrange $data_list_array($id) 1 end]
       }
}

proc replot {} {
    gets stdin line
    set list [split $line]
    set l [llength $list]
    for {set i 0} {$i < $l} {incr i} {
       entry_data $i [lindex $list $i]
        }
plot
}

frame .mbar -relief raised -bd 2
canvas .c -width [expr $width + 50] -height $height -background white
pack .mbar .c -fill both
menubutton .mbar.file -text File -menu .mbar.file.menu
menu .mbar.file.menu
.mbar.file.menu add command -label exit -command exit

menubutton .mbar.show -text Show -menu .mbar.show.menu
menu .mbar.show.menu

menubutton .mbar.scale -text Scale -menu .mbar.scale.menu
menu .mbar.scale.menu
.mbar.scale.menu add radiobutton -label plane \
      -value 0 -variable log_scale
.mbar.scale.menu add radiobutton -label log \
      -value 1 -variable log_scale
set log_scale 0
pack .mbar.file .mbar.show .mbar.scale -side left
tk_menuBar .mbar .mbar.show
focus .mbar

fileevent stdin readable replot