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:

----
  package require Tk
  # Transparent Clock in pure Tcl:

  array set Config {
    X,base   10
    Y,base   10
    X,incr  190
    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
  }

  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
    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)

    if {$H != $foo(H)} {
      set foo(H) $H
      foreach x $foo(h) {destroy $x}
      set foo(h) [drawTransNumber .trans $sx $sy $H]
    }
    incr sx $C(X,incr)
    incr sy $C(Y,incr)

    if {$M != $foo(M)} {
      set foo(M) $M
      foreach x $foo(m) {destroy $x}
      set foo(m) [drawTransNumber .trans $sx $sy $M]
    }
    incr sx $C(X,incr)
    incr sy $C(Y,incr)

    if {$S != $foo(S)} {
      set foo(S) $S
      foreach x $foo(s) {destroy $x}
      set foo(s) [drawTransNumber .trans $sx $sy $S]
    }
    after 1000 tick
  }
  tick

  # Show the coords, useful with the new move command:
  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

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

  # Allow moving the clock:
  pack [button .move -command move -text "Move here"] -side left

  proc move {} {
    global Config foo
    
    foreach x [after info] {after cancel $x}
    array set foo {H 0 M 0 S 0}
    set Config(X,base) [winfo x .]
    set Config(Y,base) [winfo y .]
    tick
  }


----
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!!
[tonytraductor] - Okay, where's the code for this canvas, and, can the same (transparency) be done with a text widget (and work Linux)?

[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
   2. put the "if ...wm attributes $rootname$segment -topmost 1" section below the "wm geometry $rootname$segment..." part to avoid flickering windows.

[slebetman] That's weird because I develop on XP. I've tested it on several machines now and haven't encountered the "tick" problem.

The flidkering windows problem doesn't go away even if you move "wm geometry". To see what I mean try this simpler version of the "tick" proc:
  set foo [list]
  proc tick {} {
    global foo Config
    after 1000 tick
  
    foreach x $foo {destroy $x}
  
    set now [clock seconds]
    set now [clock format $now -format "%I:%M:%S"]
    set foo [drawTransNumber .trans $Config(X) $Config(Y) $now]
  }
  tick
This tick proc would have been much nicer as a demo since it's simpler and easier to read. But it flickers horribly.
----
[LV] I wasn't able to figure out exactly how to move this once it
displayed.

[UK]  You don't, you walk around it ;-))

[LV]: Then is there a way to place it where it isn't in the way?  Because the default is in a really weird place that makes it hard to read the numbers due to the surrounding stuff.

[UK]  You can change Screen X and Y and incr with the Config array at global scope.

[slebetman] Wow! barely 12 hours and the code is already getting third party contributions. Thank you [UK], your style is different from mine but I like how Config is self-documenting at the top of the file while C is nice and short when it actually needs to be used :)

Added the ability to move the digits. It doesn't save the position but it does display the X-Y coordinates so you can later edit the source to place the clock at your preferred location.
----
[rdt] 2006.12.01  Well, I prefer the following segmentlist with a -highlightthickness of 0:
     set segmentList {
       a 02356789    0  0   60 10
       b 045689      0  0   10 60
       c 0234789    50  0   10 60
       d 2345689     0 50   60 10
       e 0268        0 50   10 60
       f 03456789   50 50   10 60
       g 0235689     0 100  60 10
       h 1          25  0   10 110
     }
----
[Category Application]
[Category Date and Time]