Version 13 of An analog clock in Tk
Updated 2003-10-16 13:01:43Kevin Kenny - Chia-Wei Chow wrote in news:comp.lang.tcl : I cannot turn the hands of a clock(gif file).
Why a gif? Much easier with a canvas:
grid [canvas .c -width 200 -height 200]
set halfpi 1.570796
set piover6 0.5235987
set twopi 6.283185
.c create oval 2 2 198 198 -fill white -outline black
for { set h 1 } { $h <= 12 } { incr h } {
set angle [expr { $halfpi - $piover6 * $h }]
set x [expr { 100 + 90 * cos($angle) }]
set y [expr { 100 - 90 * sin($angle) }]
.c create text $x $y -text $h -font {Helvetica -12}
}
proc hands {} {
catch { .c delete withtag hands }
# Compute seconds since midnight
set s [expr { [clock seconds] - [clock scan 00:00:00] }]
# Angle of second hand
set angle [expr { $s * $::twopi / 60. }]
set y [expr { 100 - 90 * cos($angle) }]
set x [expr { 100 + 90 * sin($angle) }]
.c create line 100 100 $x $y -width 1 -tags hands
# Minute hand
set angle [expr { $s * $::twopi / 60. / 60. }]
set y [expr { 100 - 85 * cos($angle) }]
set x [expr { 100 + 85 * sin($angle) }]
.c create line 100 100 $x $y -width 3 -capstyle projecting -tags hands
# Hour hand
set angle [expr { $s * $::twopi / 60. / 60. / 12. }]
set y [expr { 100 - 60 * cos($angle) }]
set x [expr { 100 + 60 * sin($angle) }]
.c create line 100 100 $x $y -width 7 -capstyle projecting -tags hands
after 1000 hands
}
handsRS Not matching the title, but here's a cute little digital clock I originally wrote for Einfach Tcl:
proc every {ms body} {
eval $body
after $ms [list every $ms $body]
}
pack [label .clock -textvar time]
every 1000 {set ::time [clock format [clock sec] -format %H:%M:%S]}...and both combined in A little A/D clock.
ALM Neither matching the title, but nice too. A clock that shows the time in binary, that had its origin in RS's little digital clock and some help from alfe at cs dot tu-berlin dot de. It's my first approach to tcl/tk, so I excuse myself in advance for my humble skills. - RS: Very cool, thanks for sharing this!
set radius 35
wm title . "BClock, initializing..."
wm maxsize . [expr $radius*6+1] [expr $radius*4+1]
wm minsize . [expr $radius*6+1] [expr $radius*4+1]
wm geometry . [expr $radius*6+1]x[expr $radius*4+1]
pack [canvas .b -background black]
foreach col {0 1 2 3 4 5} {
foreach bit {0 1 2 3} {
set x1 [expr $col * $radius]
set y1 [expr $radius*3 - $bit * $radius]
set x2 [expr $x1 + $radius]
set y2 [expr $y1 + $radius]
set layout(x${col}y${bit}) [.b create oval $x1 $y1 $x2 $y2]
}
}
proc delay {ms body} {
eval $body
after $ms [list delay $ms $body]
}
delay 1000 {
global layout
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 bit {0 1 2 3} {
if { $value & (1 << $bit) } {
set colour IndianRed1
} else {
set colour DarkRed
}
.b itemconfigure $layout(x${col}y${bit}) -fill $colour
}
}
}... and if you don't mind, mail ideas/corrections/additions to dondy at gmx dot de, as i don't come around much :)
RS has gone over the code with some KISS suggestions to make things simpler, especially:
- wm resizable saves the need for explicit max/minsize
- canvas tags save the need for a global array
- foreach can iterate over more than one list
set radius 35
wm title . "BClock, initializing..."
#wm maxsize . [expr $radius*6+1] [expr $radius*4+1]
#wm minsize . [expr $radius*6+1] [expr $radius*4+1]
wm geometry . [expr $radius*6+1]x[expr $radius*4+1]
wm resizable . 0 0 ;#-- eliminate maxsize, minsize
pack [canvas .b -background black]
foreach col {0 1 2 3 4 5} {
foreach bit {0 1 2 3} {
set x1 [expr $col * $radius]
set y1 [expr $radius*3 - $bit * $radius]
set x2 [expr $x1 + $radius]
set y2 [expr $y1 + $radius]
#set layout(x${col}y${bit}) [.b create oval $x1 $y1 $x2 $y2]
#-- use canvas tag instead of global array
.b create oval $x1 $y1 $x2 $y2 -tag $col,$bit
}
}
proc every {ms body} {
eval $body
after $ms [info level 0]
}
every 1000 {
#global layout ;#-- not needed, as we're in global scope
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 {
#-- use multi-list foreach instead of lindexing
#set value [lindex $values $col]
foreach bit {0 1 2 3} {
#-- use conditional assignment instead of [if]
#if { $value & (1 << $bit) } {
# set colour IndianRed1
#} else {
# set colour DarkRed
#}
set colour [expr {$value & (1<<$bit)? "IndianRed1": "DarkRed"}]
.b itemconfigure $col,$bit -fill $colour
}
}
}ALM Added resizing stuff (now you can resize it "freely" until 6000x4000 pixels, guess that's enough. Applied RSs improvements too, for sure (thanks again RS). I hope it's a usefull thing or a nice read.
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]
.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
}
}
}