Version 28 of An analog clock in Tk
Updated 2006-04-05 18:23:47Kevin 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
}
}
}TV Heer heer. Could be just a matter of taste, but that's code that can be read and is efficient, and is probably decently designable according to (as I learned as early engineering student) nassi-schneider diagram and progressive refinement, so also formalizable. How often does that happen in modern software province?
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]
.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
}
}
}escargo 16 Oct 2003 -- When I used wish-reaper to download this page and then ASED to untangle all the clocks in it, I discovered something strange about the last binary clock just above. When I run it, the clock appears, and then it shrinks to the upper middle and quickly vanishes. If I redisplay the clock (hide it behind another window or iconize it and then uncover or display it), the clock reappears, and then shrinks off into the distance again. (This is running on Microsoft Windows XP with ActiveTcl 8.4.1.0.)
Doing a little more investigation, I found that the value for radius was steadily decreasing until it reached the value -1.
ALM Uh, sorry. That didn't happen for me, and sure, I know why, and changed it now (just that people don't think you're crazy ;). I hope it's ok now.
escargo 17 Oct 2003 - All better now. I am curious about why the problem was not visible to you originally.
ALM I use the window manager ion (http://modeemi.cs.tut.fi/~tuomov/ion/ ), i think that's why :)
wdb Here my version of an analog clock in Tk:
package require Tk
canvas .uhr -width 200 -height 200 -highlightthickness 0
wm geometry . +[expr {[winfo screenwidth .]-[winfo reqwidth .]}]+0
pack .uhr
bind .uhr <Double-Button-1> {
if {[expr {![wm overrideredirect .]}]} {
wm overrideredirect . yes
# .uhr configure -background SystemBackground
} else {
wm overrideredirect . no
# .uhr configure -background SystemButtonFace
}
}
set PI [expr {asin(1)*2}]
set sekundenzeigerlaenge 85
set minutenzeigerlaenge 75
set stundenzeigerlaenge 60
proc drawClock {} {
global PI
global sekundenzeigerlaenge
global minutenzeigerlaenge
global stundenzeigerlaenge
set aussenradius 95.0
set innenradius 83.0
# Ziffernblatt
.uhr create oval 5 5 195 195 -fill white -outline ""
# Zeiger
.uhr create line 100 100 [expr {100+$stundenzeigerlaenge}] 100 -tag stundenschatten
.uhr create line 100 100 100 [expr {100-$minutenzeigerlaenge}] -tag minutenschatten
.uhr create line 100 100 100 [expr {100+$sekundenzeigerlaenge}] -tag sekundenschatten
.uhr create line 100 100 [expr {100+$stundenzeigerlaenge}] 100 -tag {stundenzeiger zeiger}
.uhr create line 100 100 100 [expr {100-$minutenzeigerlaenge}] -tag {minutenzeiger zeiger}
.uhr create line 100 100 100 [expr {100+$sekundenzeigerlaenge}] -tag {sekundenzeiger zeiger}
.uhr itemconfigure stundenzeiger -width 8
.uhr itemconfigure minutenzeiger -width 4
.uhr itemconfigure sekundenzeiger -width 2 -fill red
.uhr itemconfigure stundenschatten -width 8 -fill gray
.uhr itemconfigure minutenschatten -width 4 -fill gray
.uhr itemconfigure sekundenschatten -width 2 -fill gray
# Ziffern
for {set i 0} {$i < 60} {incr i} {
set r0 [expr {$innenradius + 5}]
set r1 [expr {$innenradius +10}]
set x0 [expr {sin($PI/30*(30-$i))*$r0+100}]
set y0 [expr {cos($PI/30*(30-$i))*$r0+100}]
set x1 [expr {sin($PI/30*(30-$i))*$r1+100}]
set y1 [expr {cos($PI/30*(30-$i))*$r1+100}]
if {[expr {$i%5}]} {
}
}
for {set i 0} {$i < 12} {incr i} {
set x [expr {sin($PI/6*(6-$i))*$innenradius+100}]
set y [expr {cos($PI/6*(6-$i))*$innenradius+100}]
.uhr create text $x $y \
-text [expr {$i ? $i : 12}] \
-font {Helvetica 13 bold} \
-fill #666666 \
-tag ziffer
}
wm resizable . no no
}
proc stundenZeigerAuf {std} {
global PI
global stundenzeigerlaenge
set x0 100
set y0 100
set dx [expr {sin ($PI/6*(6-$std))*$stundenzeigerlaenge}]
set dy [expr {cos ($PI/6*(6-$std))*$stundenzeigerlaenge}]
set x1 [expr {$x0 + $dx}]
set y1 [expr {$y0 + $dy}]
.uhr coords stundenzeiger $x0 $y0 $x1 $y1
set schattenabstand 3
set x0s [expr {$x0 + $schattenabstand}]
set y0s [expr {$y0 + $schattenabstand}]
set x1s [expr {$x1 + $schattenabstand}]
set y1s [expr {$y1 + $schattenabstand}]
.uhr coords stundenschatten $x0s $y0s $x1s $y1s
}
proc minutenZeigerAuf {min} {
global PI
global minutenzeigerlaenge
set x0 100
set y0 100
set dx [expr {sin ($PI/30*(30-$min))*$minutenzeigerlaenge}]
set dy [expr {cos ($PI/30*(30-$min))*$minutenzeigerlaenge}]
set x1 [expr {$x0 + $dx}]
set y1 [expr {$y0 + $dy}]
.uhr coords minutenzeiger $x0 $y0 $x1 $y1
set schattenabstand 4
set x0s [expr {$x0 + $schattenabstand}]
set y0s [expr {$y0 + $schattenabstand}]
set x1s [expr {$x1 + $schattenabstand}]
set y1s [expr {$y1 + $schattenabstand}]
.uhr coords minutenschatten $x0s $y0s $x1s $y1s
}
proc sekundenZeigerAuf {sec} {
global PI
global sekundenzeigerlaenge
set x0 100
set y0 100
set dx [expr {sin ($PI/30*(30-$sec))*$sekundenzeigerlaenge}]
set dy [expr {cos ($PI/30*(30-$sec))*$sekundenzeigerlaenge}]
set x1 [expr {$x0 + $dx}]
set y1 [expr {$y0 + $dy}]
.uhr coords sekundenzeiger $x0 $y0 $x1 $y1
set schattenabstand 5
set x0s [expr {$x0 + $schattenabstand}]
set y0s [expr {$y0 + $schattenabstand}]
set x1s [expr {$x1 + $schattenabstand}]
set y1s [expr {$y1 + $schattenabstand}]
.uhr coords sekundenschatten $x0s $y0s $x1s $y1s
}
proc showTime {} {
after cancel showTime
after 1000 showTime
set secs [clock seconds]
set l [clock format $secs -format {%H %M %S} ]
wm title . [join $l :]
set std [lindex $l 0]
set min [lindex $l 1]
set sec [lindex $l 2]
regsub ^0 $std "" std
regsub ^0 $min "" min
regsub ^0 $sec "" sec
set min [expr {$min + 1.0 * $sec/60}]
set std [expr {$std + 1.0 * $min/60}]
stundenZeigerAuf $std
minutenZeigerAuf $min
sekundenZeigerAuf $sec
}
drawClock
showTimeThe code is a tigerish mixture of German & English, here some hints:
- Uhr = clock
- Sekundenzeiger = second hand
- Minutenzeiger = minute hand
- Stundenzeiger = hour hand
- ???zeigerlaenge = length of ??? hand
- ???zeigerauf (num) = ??? hand towards (num)
- Schatten = shadow
- Abstand = distance