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)?
slebetman: The said "canvas", of course, doesn't exist. My tongue was firmly in cheek when I made the proposal :-P
PWE: Very nice, but I had to make two changes to work properly on XP:
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 flickering 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]
}
tickThis 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
}HoMi 2008-12-02: And here comes the "flickerfree" version:
The "trick" is, draw any digit of the clock if and only if it changes its value. And draw the whole clock only at startup or if the position was changed by moving the "config" window and clicking the "Move" button.
Make the following changes within the code above:
1. Remove the proc 'drawTransNumber', it is not required for this solution
2. Change the array 'foo' to
array set foo {
hT {} h {} mT {} m {} sT {} s {}
HT -1 H -1 MT -1 M -1 ST -1 S -1
}3. Change the proc 'tick' to
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]
}
}4. Use the 'every' proc from Richard Suchenwirth
proc every {ms body} {eval $body; after $ms [info level 0]}
every 1000 tick ;# redraw the 'changed' digits only one time per second5. Change the proc 'move' to
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
}The flickering in the original code was the result of the fact that the segments of both digits of the seconds value were destroyed, and after this the required segments of both digits for the new value were created. This means the tens digit was destroyed and redrawn also if its value was the same.
A further step could be that only the segments of a digit will be destroyed which are not required to show the next value, and after this the additional segments required for the next value will be created. This would result in a 100 percent flickerfree clock. But this requires a complete redesign of the application.
slebetman: Would you mind posting the complete reworked/redesigned code on a separate, dedicated page (perhaps FlickerFreeTransparentDigitalClock) so that people can simply copy and paste it instead of having to do copy/paste/modify ?
MJ: I am probably missing something, but why destroy and recreate the different segments? Can't you just wm withdraw them?