Homepage: http://virtuelle.gefil.de/~dondy
Here's a revised version of the BClock.tcl, now resizes the ovals and canvas, but still lacks of a proper wm aspect . blah blah definition. (dunno how to do that yet)
set radius 10
wm title . "BClock, initializing..."
wm aspect . 6 4 6000 4000
wm geometry . [expr $radius*6+1]x[expr $radius*4+1]
proc create_resize_ovals {value radius} {
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 } {
.b create oval $x1 $y1 $x2 $y2 -tag $col,$row
} elseif { $value == 1 } {
.b coords $col,$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 - 1]
wm aspect . 6 4 6000 4000
.b configure -width [expr $radius * 6] -height [expr $radius * 4]
create_resize_ovals 1 $radius
}
proc every {ms body} {
eval $body
after $ms [info level 0]
}
pack [canvas .b -background black]
create_resize_ovals 0 $radius
bind . <Configure> { resize_canvas_ovals %w %h }
every 1000 {
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} value $values {
foreach bit {0 1 2 3} {
set colour [expr {$value & (1 << $bit)? \
"IndianRed1": "DarkRed"}]
.b itemconfigure $col,$bit -fill $colour
}
}
}