使用 tcl/tk 画布进行实时绘图

Question

我正在尝试使用 tcl/tk 画布实用程序在文件中绘制实时更改。我编写了一个简单的代码来查找文件中的差异并使用.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
                }
            }
         }
     }
}}

您可能还希望在检查文件是否存在之前进行延迟，这样不存在的文件就不会导致您对操作系统进行重击。