Homepage: http://virtuelle.gefil.de/~dondy
Here's a revised version of the BClock.tcl (added humm, a event handler for resizing the canvas and ovals?), it just doesn't work properly yet.
set radius 20
wm title . "BClock, initializing..."
wm geometry . [expr $radius*6+1]x[expr $radius*4+1]
proc create_resize_ovals {value radius} {
global items
foreach col {0 1 2 3 4 5} {
foreach row {0 1 2 3} {
set x1 [expr $col * $radius]
set y1 [expr $radius * 3 - $row * $radius]
set x2 [expr $x1 + $radius]
set y2 [expr $y1 + $radius]
if { $value == 0 } {
set items(x${col}y${row}) [ .b create oval $x1 $y1 \
$x2 $y2 ]
} elseif { $value == 1 } {
.b coords $items(x${col}y${row}) $x1 $y1 $x2 $y2
} else {
#this just shouldn't happen :P
exit 1
}
}
}
}
proc resize_canvas_ovals {width height} {
global radius
set radius [expr ($width / 6 + $height / 4) / 2 - 2]
.b configure -width $width -height $height
create_resize_ovals 1 $radius
}
proc every_ms_do {ms body} {
eval $body
after $ms [list every_ms_do $ms $body]
}
pack [canvas .b -background black]
create_resize_ovals 0 $radius
bind . <Configure> { resize_canvas_ovals %w %h }
every_ms_do 1000 {
global items
set time [ clock format [ clock sec ] -format "%T" ]
regexp {([0-2])([0-9]):([0-5])([0-9]):([0-5])([0-9])} \
$time -> h1 h2 m1 m2 s1 s2
wm title . "BClock, $time"
set values [list $h1 $h2 $m1 $m2 $s1 $s2]
foreach col {0 1 2 3 4 5} {
set value [lindex $values $col]
foreach row {0 1 2 3} {
if { $value & (1 << $row) } {
set colour IndianRed1
} else {
set colour DarkRed
}
.b itemconfigure $items(x${col}y${row}) -fill $colour
}
}
}