Search code examples
linuxloopstimetcltk-toolkit

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


What I want is something similar to this bash shell script just below:

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

Perhaps the most obvious is to convert it to Tcl/Tk. I even tried, but I still did not succeed. See:

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

I'm still committed and working for this to work identically to the example quoted - bash script. But do not rule out improvements and suggestions that you can promote.

What I have in mind something like:

enter image description here

If someone here knows and wants to share the idea, feel free.


Solution

  • There are several issues with your Tcl code:

    • proc _pause{ } { -- Tcl is very whitespace sensitive, so you need to separate the procedure name from the argument list
    • s=[expr s+1] -- use set to set variables, and you need to use $s to get the variable value: set s [expr {$s+1}] or in this case use the incr command incr s
    • if { $s -eq 60 } and if { "$key" = "s" } -- see the expr man page for the correct operators. You want {$s == 60} and {$key eq "s"}
    • stty -echo -icanon min 0 -- stty is an external command, so you need exec stty ...

    Those are the main syntax problems. Your indentation style can be improved so you code can be readable and maintainable.


    I thought this was an interesting challenge so I decided to implement it independently of your code. Let me know if you have any questions:

    #!/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