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

Issue

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

Answered By – glenn jackman

This Answer collected from stackoverflow, is licensed under cc by-sa 2.5 , cc by-sa 3.0 and cc by-sa 4.0

Leave a Reply

(*) Required, Your email will not be published