# Transparent Clock in pure Tcl:
 # original code by slebetman
 #
 # improvements for a flickerfree version
 # by HoMi
 
 # base position
 array set Config {
     X,base   10
     Y,base   10
     X,incr  160
     Y,incr    0
 }
 
 proc drawTransDigit {rootname x y number} {
   set ret [list]
   if {[string is integer -strict $number] &&
       [string length $number] == 1} {
     set segmentList {
         a 02356789   10   0 40 10
         b 045689      0  10 10 40
         c 01234789   50  10 10 40
         d 2345689    10  50 40 10
         e 0268        0  60 10 40
         f 013456789  50  60 10 40
         g 0235689    10 100 40 10
     }
     foreach {segment group x1 y1 width height} $segmentList {
       if {[string first $number $group] != -1} {
         # Experiment with -bg, -highlightbackground and
         # -highlightthickness to get the look you like:
         lappend ret [toplevel $rootname$segment \
             -bg red -highlightbackground yellow \
             -highlightthickness 1]

         # You should also experiment with other stuff
         # which affects toplevels like -relief and
         # wm attribute -alpha etc.
 
         # Unfortunately, only windows support -topmost
         # which I consider the "proper" behavior
         if {[lindex [winfo server .] 0] == "Windows"} {
           wm attributes $rootname$segment -topmost 1
         }
 
         wm overrideredirect $rootname$segment 1
         incr x1 $x
         incr y1 $y
         wm geometry $rootname$segment ${width}x${height}+${x1}+${y1}
       }
     }
   }
   return $ret
 }

 # improvement for drawing each digit separat
 # and only if it is required
 array set foo {
     hT {}  h {}  mT {}  m {}  sT {}  s {}
     HT -1  H -1  MT -1  M -1  ST -1  S -1
 }
 proc tick {} {
   global foo
   upvar #0 Config C
 
   set now [clock seconds]
   foreach {H M S} [split [clock format $now -format "%I.%M.%S"] .] break
 
   set sx $C(X,base)
   set sy $C(Y,base)
 
   foreach {HT H} [split $H {}] break
   if {$HT != $foo(HT)} {
     set foo(HT) $HT
     foreach x $foo(hT) {destroy $x}
     set foo(hT) [drawTransDigit .trans$sx $sx $sy $HT]
   }
   if {$H != $foo(H)} {
     set sx1 [expr {$sx + 70}] ;# distance between the two digits of the hours value
     set foo(H) $H
     foreach x $foo(h) {destroy $x}
     set foo(h) [drawTransDigit .trans$sx1 $sx1 $sy $H]
   }
 
   incr sx $C(X,incr)
   incr sy $C(Y,incr)
 
   foreach {MT M} [split $M {}] break
   if {$MT != $foo(MT)} {
     set foo(MT) $MT
     foreach x $foo(mT) {destroy $x}
     set foo(mT) [drawTransDigit .trans$sx $sx $sy $MT]
   }
   if {$M != $foo(M)} {
     set sx1 [expr {$sx + 70}] ;# distance between the two digits of the minutes value
     set foo(M) $M
     foreach x $foo(m) {destroy $x}
     set foo(m) [drawTransDigit .trans$sx1 $sx1 $sy $M]
   }
 
   incr sx $C(X,incr)
   incr sy $C(Y,incr)
 
   foreach {ST S} [split $S {}] break
   if {$ST != $foo(ST)} {
     set foo(ST) $ST
     foreach x $foo(sT) {destroy $x}
     set foo(sT) [drawTransDigit .trans$sx $sx $sy $ST]
   }
   if {$S != $foo(S)} {
     set sx1 [expr {$sx + 70}] ;# distance between the two digits of the seconds value
     set foo(S) $S
     foreach x $foo(s) {destroy $x}
     set foo(s) [drawTransDigit .trans$sx1 $sx1 $sy $S]
   }
 }
 
 proc every {ms body} {eval $body; after $ms [info level 0]} ;# thanks to [RS]
 every 1000 tick ;# redraw the 'changed' digits only one time per second
 
 # the 'configuration' window to move and/or exit the clock
 # show the coords
 pack [frame .fy] -side top
 pack [label .fy.l -text "Y,base :"] -side left
 pack [label .fy.v -textvariable Config(Y,base)] -side right
 pack [frame .fx] -side top
 pack [label .fx.l -text "X,base :"] -side left
 pack [label .fx.v -textvariable Config(X,base)] -side right
 # allow to movie the clock
 pack [button .move -command move -text "Move here"] -side left
 # allow to exit
 pack [button .exit -command exit -text "Exit"] -side right
 
 proc move {} {
     global Config foo
 
     array set foo {HT -1 H -1 MT -1 M -1 ST -1 S -1}
     set Config(X,base) [winfo x .]
     set Config(Y,base) [winfo y .]
     tick ;# redraw the whole clock at the new position
 }