Time and again I am amazed at how Tcl seem to be able to implement ''impossible'' feats. In a c.l.t thread someone asked if Tcl can draw opaque GUI elements in a fully transparent window. Specifically he wanted to draw a digital clock with a fully transparent background.

Eventually someone pointed out that Windows can do this and TWAPI was accordingly hacked to support it. But somewhere along the way Uwe Klein suggested a way to do a hack in pure Tcl.

Basically we draw GUI elements, in this case a 7-segment display using nothing but toplevels. Here's my stab at it:

  # Transparent Clock in pure Tcl:
  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
  }

  proc drawTransNumber {rootname x y number} {
    set ret [list]
    foreach i [split $number {}] {
      set ret [concat $ret [drawTransDigit $rootname$x $x $y $i]]
      incr x 70
    }
    return $ret
  }

  # The code can indeed be simpler than this
  # but the simple version flickers too much
  # for my taste. All this voodoo is merely
  # to reduce flicker: 
  array set foo {
    h {} m {} s {}
    H 0 M 0 S 0
  }
  proc tick {} {
    global foo
    set now [clock seconds]
    foreach {H M S} [split [clock format $now -format "%I.%M.%S"] .] break
    if {$H != $foo(H)} {
      set foo(H) $H
      foreach x $foo(h) {destroy $x}
      set foo(h) [drawTransNumber .trans 10 10 $H]
    }
    if {$M != $foo(M)} {
      set foo(M) $M
      foreach x $foo(m) {destroy $x}
      set foo(m) [drawTransNumber .trans 200 10 $M]
    }
    if {$S != $foo(S)} {
      set foo(S) $S
      foreach x $foo(s) {destroy $x}
      set foo(s) [drawTransNumber .trans 390 10 $S]
    }
    after 1000 tick
  }
  tick

  # To allow us to easily kill this beast:
  pack [button .exit -command exit -text Exit]


And for my next trick, a pure Tcl "canvas" supporting full transparency using nothing but hundreds of thousands of pixel-sized toplevels! ;-)

[TR] - Hey, this is really cool! And it works on Linux here with -topmost and being sticky, too. What a great idea doing it with toplevels!!

[PWE] Very nice, but I had to make two changes to work properly on XP:
   1 replace "tick" by "after 100 tick" otherwise it would not show hours and seconds
   1 put the "if ...wm attributes $rootname$segment -topmost 1" section below the "wm geometry $rootname$segment..." part to avoid flickering windows.