如何用Tcl/Tk语言创建带有文本模式控件的定时器

How to create a timer with text mode control in the Tcl / Tk language

我想要的是类似于下面这个 bash shell 脚本的东西:

Shell Bash

#!/bin/bash
# shell timer
# Note: Do not measure time precisely because there is loss in calculations and other commands
# For a human being is something almost imperceptible, fortunately.
# ------------------------------------------------- -----------------------------
s=00
m=00
h=00

key=""

function _screen() {
clear
# Shows the elapsed time on the terminal screen and plays to the time.txt file always updating
printf "%02d:%02d:%02d" $h $m $s > ~/time.txt
  echo ":: 'p' to pause, 'c' to continue and 's' to exit ::"
}

function _time() {
    _screen
  sleep 1
  s=$((s+1))
  [ $s -eq 60 ] && m=$((m+1)) && s=00
  [ $m -eq 60 ] && h=$((h+1)) && m=00
}

function _pause() {
while :
do
    _screen
    sleep 1
    read key
    [ "$key" = "c" ] && clear && break
done
}

function _main() {

# Put the terminal in special character interpretation mode
stty -echo -icanon min 0

while :
do
    [ "$key" = "s" ] && break   
    [ "$key" = "p" ] && _pause
    _time
    read key
done

# Restores the default mode
stty sane

exit 0
}
_main

也许最明显的是将其转换为 Tcl/Tk。我什至尝试过,但我仍然没有成功。参见:

Shell Tclsh

#!/usr/bin/env tclsh
# shell timer
# Note: Do not measure time precisely because there is loss in calculations and other commands
# For a human being is something almost imperceptible, fortunately.
# ------------------------------------------------- -----------------------------
set s 00
set m 00
set h 00

puts -nonewline ""
flush stdout
set key [gets stdin]

proc _screen{ } {
clear


set archive [open [pwd]/time.txt w]

# Shows the elapsed time on the terminal screen and plays to the time.txt file always updating
puts $archive "%02d:%02d:%02d" $h $m $s" 
puts -nonewline ":: 'p' to pause, 'c' to continue and 's' to exit ::"


}

proc _time{ } {
    _screen
  after 1000
  s=[expr s+1]
  if { $s -eq 60 } { m=[expr m+1] } { s=00 }
  if { $m -eq 60 } { h=[expr h+1] } { m=00 }
}

proc _pause{ } {
while { 1 } 
{
    _screen
  after 1000
    $argv key
    if { "$key" = "c" } { break }
  }
}

proc _main{ } {

# Put the terminal in special character interpretation mode
stty -echo -icanon min 0

while { 1 } 
{
    if { "$key" = "s" } { break }
    if { "$key" = "p" } { _pause }
    _time
    $argv key

}

# Restores the default mode
stty sane
close $archive
exit 0
}
after 1000 _main

我仍然致力于并努力使它与引用的示例相同 - bash 脚本。但不排除你可以推广的改进和建议。

What I have in mind something like:

如果这里有人知道并想分享这个想法,请随意。

您的 Tcl 代码存在几个问题:

  • proc _pause{ } { -- Tcl 对空格非常敏感,因此您需要将过程名称与参数列表分开
  • s=[expr s+1] -- 使用set设置变量,需要使用$s获取变量valueset s [expr {$s+1}] 或者在这种情况下使用 incr 命令 incr s
  • if { $s -eq 60 }if { "$key" = "s" } -- 请参阅 expr 手册页以了解正确的运算符。 你想要 {$s == 60}{$key eq "s"}
  • stty -echo -icanon min 0 -- stty是外部命令,所以需要exec stty ...

这些是主要的语法问题。您的缩进样式可以改进,使您的代码可读和可维护。


我认为这是一个有趣的挑战,所以我决定独立于您的代码来实现它。如果您有任何问题,请告诉我:

#!/usr/bin/env tclsh

set seconds 0
set running true
array set status {
    false "(paused)"
    true  "        "
}

#################################################################
proc main {} {
    enableRaw

    puts "'p' to pause; 'c' to continue; 'q' to quit"
    every 1000 display_time

    chan configure stdout -buffering none
    chan configure stdin -blocking no -buffering none
    chan event stdin readable handleStdin

    vwait ::forever

    disableRaw
    puts ""
}

# ref https://wiki.tcl.tk/14693
proc enableRaw {{channel stdin}} {
    exec /bin/stty raw -echo <@$channel
}
proc disableRaw {{channel stdin}} {
    exec /bin/stty -raw echo <@$channel
}

proc every {ms code} {
    after $ms [list every $ms $code]
    uplevel #0 $code
}

proc display_time {{event ""}} {
    global running seconds
    puts -nonewline "\r [format_time] $::status($running) "
    if {$running && $event eq ""} {incr seconds}
}

proc format_time {} {
    return [clock format $::seconds -format "%H:%M:%S" -gmt true]
}

proc handleStdin {} {
    set data [chan read stdin 1]
    switch -- $data {
        P - p {set ::running false; display_time}
        C - c {set ::running true;  display_time unpausing}
        Q - q {set ::forever "now"}
    }
}

#################################################################
main

这是对 enableRawdisableRaw 的轻微修改,execstty 没有:

package require term::ansi::ctrl::unix

proc enableRaw {} {
    term::ansi::ctrl::unix::raw
}

proc diableRaw {} {
    term::ansi::ctrl::unix::cooked
}