使用tcl / tk canvas进行实时绘图

Question

我正在尝试使用tcl/tk canvas实用程序在文件中绘制实时更改。我编写了一个简单的代码来查找文件中的差异并使用.c create line $oldx $oldy $newx $newy命令绘制它。

我的代码有一个while循环来继续检查文件中的更改。当我注释掉while循环时，情节画布打开很好，但是当我取消注释while循环时，情节画布根本不会打开。

请建议编辑，代码：

#!/usr/bin/wish
#PROGRAM 2 : Print something when a file is changed
#
#package require Tk

#graph prep
 set width 100
 set height 100
 canvas .c -width $width -height $height -background white
 pack .c

#bind .c <Configure> {
#    bind .c <Configure> {}
#    .c xview scroll 0 unit
#    set t 0
#}
#set t 0
#.c create line $t 239 [expr $t + 5] 239 -fill gray
.c create line 0 12 1 13

#Initial reading
 set filename "data.txt"
 #puts $filename
 if [file exists $filename] {
     #puts "file exits!"
    set accessTime [file mtime $filename]
    #puts $accessTime
 }
 #opening file
 set a [open $filename]
 set lines [split [read -nonewline $a] "\n"]
 close $a;                          # Saves a few bytes :-)
 #puts [llength $lines]

 #printing file
 set oldx 0
 set oldy [lindex $lines 0]
 for {set i 1} {$i < [llength $lines]} {incr i} {
     #puts "$i : [lindex $lines $i]"
     set newx $i
     set newy [lindex $lines $i]
     .c create line $oldx $oldy $newx $newy
     set oldx $newx
     set oldy $newy
 }

## after 10000
## #looping to detect change
 while 1 {
     if [file exists $filename] {
    after 1000      
         #  check if new access time
        set nAccessTime [file mtime $filename]
        if {$accessTime != $nAccessTime} {
        #puts $nAccessTime
            #puts "found new"
        #update access time
            set accessTime $nAccessTime
        #read new lines 
        set a [open $filename]
        set lines [split [read -nonewline $a] "\n"]
        close $a;                          # Saves a few bytes :-)
        #puts [llength $lines]

        for {} {$i < [llength $lines]} {incr i} {
            #puts "$i : [lindex $lines $i]"
            set newx $i
            set newy [lindex $lines $i]
            .c create line $oldx $oldy $newx $newy
            set oldx $newx
            set oldy $newy
        }
        }
     }
 }

Answer 1

这是在Tk中进行动态时间驱动更新的典型问题（动画具有相同的问题）。问题是Tk只在事件循环空闲时重绘自身;它推迟了实际绘图活动，直到发生这种情况，允许它将多个状态更改分组为一个重绘（实际效率提升）。大部分时间这种情况都是透明的，但是当你有一个像你所写的驱动循环时，你根本就没有发生任何更新。

解决这个问题的快速方法是改变：

after 1000

至：

after 1000 {set update_ready yes}
vwait update_ready

它在暂停期间运行事件循环，而不是完全停止进程。另一种方法是改为：

update
after 1000

但这非常低劣，因为这意味着应用程序在等待期间没有响应。

到目前为止，更好的是重写代码，以便它处理计时器回调中的更改。这对你的代码来说是相当重要的手术...除非你有Tcl 8.6，否则你可以使用协程来轻松完成：

 package require Tcl 8.6;    # <<<< GOOD STYLE
 package require Tk;         # <<<< GOOD STYLE

 set width 100
 set height 100
 canvas .c -width $width -height $height -background white
 pack .c

.c create line 0 12 1 13

#Initial reading
 set filename "data.txt"
 #puts $filename
 if [file exists $filename] {
     #puts "file exits!"
    set accessTime [file mtime $filename]
    #puts $accessTime
 }
 #opening file
 set a [open $filename]
 set lines [split [read -nonewline $a] "\n"]
 close $a;                          # Saves a few bytes :-)
 #puts [llength $lines]

 #printing file
 set oldx 0
 set oldy [lindex $lines 0]
 for {set i 1} {$i < [llength $lines]} {incr i} {
     #puts "$i : [lindex $lines $i]"
     set newx $i
     set newy [lindex $lines $i]
     .c create line $oldx $oldy $newx $newy
     set oldx $newx
     set oldy $newy
 }

## #looping to detect change
coroutine mainloop apply {{} {         # <<< CHANGED LINE
    global i filename accessTime oldx oldy
    while 1 {
        after 1000 [info coroutine];   # <<< CHANGED LINE
        yield;                         # <<< CHANGED LINE

        if {[file exists $filename]} {
            #  check if new access time
            set nAccessTime [file mtime $filename]
            if {$accessTime != $nAccessTime} {
                #puts $nAccessTime
                #puts "found new"
                #update access time
                set accessTime $nAccessTime
                #read new lines 
                set a [open $filename]
                set lines [split [read -nonewline $a] "\n"]
                close $a;                          # Saves a few bytes :-)
                #puts [llength $lines]

                for {} {$i < [llength $lines]} {incr i} {
                    #puts "$i : [lindex $lines $i]"
                    set newx $i
                    set newy [lindex $lines $i]
                    .c create line $oldx $oldy $newx $newy
                    set oldx $newx
                    set oldy $newy
                }
            }
         }
     }
}}

在检查文件是否存在之前，您可能还需要延迟，以便不存在的文件不会导致您敲击操作系统。