Живое построение графиков с использованием tcl / tk canvas - PullRequest
Новая
       15

Живое построение графиков с использованием tcl / tk canvas

1 голос
/ 14 марта 2019

Я пытаюсь представить изменения в файле, используя утилиту 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
        }
        }
     }
 }

1 Ответ

3 голосов
/ 14 марта 2019

Это классическая проблема с выполнением динамических управляемых временем обновлений в 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
                }
            }
         }
     }
}}

Возможно, вам также нужна задержка перед проверкой, существует ли файл, чтобы несуществующий файл не приводил к перегрузке ОС.

...