# linearclock.tcl
 # Author:      Gerard Sookahet
 # Date:        1 Oct 2022
 # Description: Display a linear clock with 3 bars

 package require Tk
 namespace import ::tcl::mathop::*
 font create ft -family Arial -weight bold -size 14
 wm geometry . +20+20
 wm overrideredirect . 1
 bind all <Escape> {exit}
 
 proc every {ms body} {
  uplevel #0 $body
  after $ms [list every $ms $body]
 }
 
 proc CreateRectangle {w color l} {
  return [$w create polygon $l -fill $color]
 }

 proc MoveRightSideRectangle {w tag x1} {
  set lcoord [$w coords $tag] 
  $w imove $tag 3 $x1 [lindex $lcoord 3]
  $w imove $tag 4 $x1 [lindex $lcoord 5]
 }
 
 set sp 10
 set xo 0
 set yo $sp
 set x1 1
 set dx 240
 set dy 40
 set wd [+ 30 $dx]
 set ht [* 3 [+ $dy $sp]]
 
 pack [canvas .c -width $wd -height $ht -bg black] -fill both -expand yes
 
 lmap {t clr} {H green M orange S yellow} {
     set tag($t) [CreateRectangle .c $clr [list $xo $yo $x1 $yo $x1 [+ $yo $dy] $xo [+ $yo $dy]]]
     set tag([string tolower $t 0 0]) [.c create text [+ $dx 10] [+ $yo [/ $dy 2]] \
         -fill $clr -justify left -font ft -text "0"]
     incr yo [+ $dy $sp]
 }
 
 every 1000 {
  lmap {t d} {H 24 M 60 S 60} {
      set T [scan [clock format [clock seconds] -format %$t] %d]
      set x1 [/ [* $T $::dx] $d]
      MoveRightSideRectangle .c $::tag($t) $x1
      .c itemconfigure $::tag([string tolower $t 0 0]) -text $T
  }
 }