[Kevin 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

 }
 hands
======
----
[RS] 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].
----
[WikiDbImage bclock.jpg]

[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 [namespace code [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 [RS]s improvements too, for sure (thanks again [RS]). I hope it's a useful 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:

[http://wolf-dieter-busch.de/html/res/Heimatseite/img/Uhr.png]

An anti-aliased version of this clock using tkpath [tkpath - clock]

======
 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
 showTime
======

The 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

----

[GJS] Here is another version of the same clock
   * The clock is redrawn 30 times a second, so the the hands move smoothly
   * It is resizable
   * It has tick around it
   * It has numbers 1-60, as well as 1-12 around it
   * The size/position of all elements can be resized easily by the variables at the first of the code

======
   set pi {}
   #original width/height of clock
   set size 400
   #update time (NTSC refresh rate is 30 times a sec, PAL is 25 times a second)
   #update 30 times a second so the hand moves smoothly
   set time 33
   #if update is set to 1, then redraw the entire clock, otherwize just the hands
   set resize 1
   set font Helvetica
   #these values are distances relative to the canvas size
   set cirSize 0.95        ;#size of the circle
   #these values are calculated from the center of the circle
   #relative to canvas size
   set inrLength 0.03      ;#where the hands start
   set secLength 0.45      ;#where the second hand ends
   set minLength 0.35      ;#where the minute hand ends
   set hrsLength 0.25      ;#where the hour hand ends
   set tikLength 0.40      ;#where all ticks start
   set tk2Length .43       ;#wehre the small ticks end
   set tk3Length .475      ;#where the big ticks end
   set n1pos 0.45          ;#placement of numbers 1-12
   set n2pos 0.38          ;#placement of numbers 1-60
   #width of hands, relative to canvas size
   set secWidth .015       ;#second hand
   set minWidth .025       ;#minute hand
   set hrsWidth .045       ;#hour hand
   #size of fonts, relative to canvas size 
   set fontSize 0.03       ;#1-12
   set fnt2Size 0.02       ;#1-60
   
   proc main {} {
           #setup global vars
           global pi size
           set pi [pi] ;#save pi so we don't have to call the function everytime
           
           #setup main window
           wm title . Clock
           #when the window is resized force the clock to be redrawn
           bind . <Configure> {set ::resize 1}  
           
           #create a canvas
           grid [canvas .clock -width $size -height $size -bd 0] -sticky news
           grid rowconfigure . 0 -weight 1
           grid columnconfigure . 0 -weight 1
           
           #create canvas objects, placement does not matter
           .clock create oval 5 5 195 195 -tags {circle} -fill white
           .clock create line 100 100 100 35 -width 3 -tags {hands hourhand} \
                   -fill green -capstyle round
           .clock create line 100 100 100 25 -width 5 -tags {hands minutehand} \
                   -fill blue -capstyle round
           .clock create line 100 100 100 5  -width 9 -tags {hands secondhand} \
                   -fill red -capstyle round
           
           #create numbers, 1-12
           for {set i 1} {$i <= 12} {incr i} {
                   .clock create text 0 0 -text $i -tags "n n$i"
           }
           
           #create ticks, and numbers 1-16
           for {set i 1} {$i <= 60} {incr i} {
                   .clock create line 0 0 10 10 -tags tick$i
                   .clock create text 0 0 -text $i -tags "nn nn$i"
           }
           
           #start the timer
           updateClock
   }
   
   proc updateClock {} {
           #globals
           global pi        size      cirSize
           global secLength minLength hrsLength
           global tikLength tk2Length tk3Length
           global inrLength n1pos     n2pos
           global secWidth  minWidth  hrsWidth
           global font      fontSize  resize
           global fnt2Size  time
           
           #get time
           set msec [string range [clock milliseconds] end-2 end]
           foreach {sec min hour} [clock format [clock seconds] -format "%S %M %I"] {}
           
           #find relative position
           set sp [expr (([unpad $sec] * 1000) + [unpad $msec]) / 60000.0]
           set mp [expr (((([unpad $min] * 60) + [unpad $sec]) * 1000) + [unpad $msec]) / 3600000.0]
           set hp [expr (([unpad $hour] * 60) + [unpad $min]) / 720.0]
           
           #get the size of the widget
           set w [winfo width .clock];set cx [expr $w / 2]
           set h [winfo height .clock];set cy [expr $h /2]
           set size [expr $w>$h?$h:$w]
           
           #if size changed, move numbers, ticks, and circle
           if {$resize} {
                   #move the circle
                   set x1 [expr $cx - round(($size / 2) * $cirSize)]
                   set y1 [expr $cy - round(($size / 2) * $cirSize)]
                   set x2 [expr $cx + round(($size / 2) * $cirSize)]
                   set y2 [expr $cy + round(($size / 2) * $cirSize)]
                   .clock coords circle $x1 $y1 $x2 $y2
                   
                   #move the numbers, 1-12
                   for {set i 1} {$i <= 12} {incr i} {
                           set np [expr $i / 12.0]
                           set x1 [expr $cx + ($size * $n1pos) * sin($np * $pi * 2)]
                           set y1 [expr $cy - ($size * $n1pos) * cos($np * $pi * 2)]
                           .clock coords n$i $x1 $y1
                   }
                   
                   #move the ticks, and numbers 1-60
                   for {set i 1} {$i <= 60} {incr i} {
                           set np [expr $i / 60.0]
                           if {[expr $i % 5]} {
                                   #move the long ticks
                                   set x1 [expr $cx + ($size * $tikLength) * sin($np * $pi * 2)]
                                   set y1 [expr $cy - ($size * $tikLength) * cos($np * $pi * 2)]
                                   set x2 [expr $cx + ($size * $tk3Length) * sin($np * $pi * 2)]
                                   set y2 [expr $cy - ($size * $tk3Length) * cos($np * $pi * 2)]
                                   .clock coords tick$i $x1 $y1 $x2 $y2
                           } else {
                                   #move the short ticks
                                   set x1 [expr $cx + ($size * $tikLength) * sin($np * $pi * 2)]
                                   set y1 [expr $cy - ($size * $tikLength) * cos($np * $pi * 2)]
                                   set x2 [expr $cx + ($size * $tk2Length) * sin($np * $pi * 2)]
                                   set y2 [expr $cy - ($size * $tk2Length) * cos($np * $pi * 2)]
                                   .clock coords tick$i $x1 $y1 $x2 $y2
                           }
                           #move second set of numbers
                           set x1 [expr $cx + ($size * $n2pos) * sin($np * $pi * 2)]
                           set y1 [expr $cy - ($size * $n2pos) * cos($np * $pi * 2)]
                           .clock coords nn$i $x1 $y1
                   }
                   
                   #fonts
                   .clock itemconfigure n -font "$font [expr round($fontSize * $size) * -1]"
                   .clock itemconfigure nn -font "$font [expr round($fnt2Size * $size) * -1]"
                   
                   
                   #resize the hands
                   .clock itemconfigure secondhand -width [expr round($secWidth * $size)]
                   .clock itemconfigure minutehand -width [expr round($minWidth * $size)]
                   .clock itemconfigure hourhand   -width [expr round($hrsWidth * $size)]
                   
                   #don't resize next time
                   set resize 0
           }
           
           #move the second hand
           set x1 [expr $cx + ($size * $inrLength) * sin($sp * $pi * 2)]
           set y1 [expr $cy - ($size * $inrLength) * cos($sp * $pi * 2)]
           set x2 [expr $cx + ($size * $secLength) * sin($sp * $pi * 2)]
           set y2 [expr $cy - ($size * $secLength) * cos($sp * $pi * 2)]
           .clock coords secondhand $x1 $y1 $x2 $y2
           
           #move the minute hand
           set x1 [expr $cx + ($size * $inrLength) * sin($mp * $pi * 2)]
           set y1 [expr $cy - ($size * $inrLength) * cos($mp * $pi * 2)]
           set x2 [expr $cx + ($size * $minLength) * sin($mp * $pi * 2)]
           set y2 [expr $cy - ($size * $minLength) * cos($mp * $pi * 2)]
           .clock coords minutehand $x1 $y1 $x2 $y2
           
           #move the hour hand
           set x1 [expr $cx + ($size * $inrLength) * sin($hp * $pi * 2)]
           set y1 [expr $cy - ($size * $inrLength) * cos($hp * $pi * 2)]
           set x2 [expr $cx + ($size * $hrsLength) * sin($hp * $pi * 2)]
           set y2 [expr $cy - ($size * $hrsLength) * cos($hp * $pi * 2)]
           .clock coords hourhand $x1 $y1 $x2 $y2
           
           #lets do it again sometime
           after $time updateClock
   }
   
   #short proc to remove the leading 0 from numbers
   #and make sure an int is returned
   proc unpad {int} {
           regsub ^0 $int "" int1
           if {![string is int $int1]} {
                   return 0
           }
           if {![string length $int1]} {
                   return 0
           }
           return $int1
   }
   
   #proc to return value of pi
   proc pi {} {expr acos(-1)}
   
   main
======

----

[bll] 2016-12-13 Scalable analog clock. Scales according to [tk scaling] for high resolution displays.  The window is resizeable and the clock will be redrawn to scale.  Nothing new about the clock itself.  2017-4-26 working properly on windows now.

2017-10-26: Online demo at [http://172.104.5.86:5443/cloudtk/VNC?session=new&Tk=analog-clock]. Following the link the online demo scales well to a mobile phone display also!

======
#!/usr/bin/tclsh

package require Tk

variable vars

proc doexit { } {
  exit
}

proc pscale { pixels } {
  return [expr {round(double($pixels)*[tk scaling]/1.388888888)}]
}

proc drawhand { tag v count doffset color width \
    lenmult neglenmult capstyle } {
  variable vars

  set deg [expr {(360.0/$count) * (double($v)-$doffset)}]
  set x0 [expr {-(round(double($vars(radius))*$neglenmult * \
      cos($deg*0.0174533)))+$vars(center)}]
  set y0 [expr {-(round(double($vars(radius))*$neglenmult * \
      sin($deg*0.0174533)))+$vars(center)}]
  set x [expr {round(double($vars(radius))*$lenmult * \
      cos($deg*0.0174533))+$vars(center)}]
  set y [expr {round(double($vars(radius))*$lenmult * \
      sin($deg*0.0174533))+$vars(center)}]
  if { [info exists vars($tag)] } {
    $vars(canvas) delete $vars($tag)
  }
  set vars($tag) [$vars(canvas) create line \
      $x0 $y0 $x $y \
      -fill $color \
      -width $width \
      -capstyle $capstyle \
      -smooth true \
      ]
}

proc hour { } {
  variable vars

  set sz [expr {round(9.0*$vars(scaling))}]
  set v [expr {[clock format $vars(tm) -format %l]}]
  regsub {^0*(.)} $v {\1} v
  set vm [expr {[clock format $vars(tm) -format %M]}]
  regsub {^0*(.)} $vm {\1} vm
  set v [expr {double($v)+double($vm)/60.0}]
  drawhand hourhand $v 12.0 3.0 $vars(fgcol) [pscale $sz] 0.5 0.1 butt
}

proc minute { } {
  variable vars

  set sz [expr {round(4.0*$vars(scaling))}]
  set v [expr {[clock format $vars(tm) -format %M]}]
  regsub {^0*(.)} $v {\1} v
  drawhand minutehand $v 60.0 15.0 $vars(fgcol) [pscale $sz] 0.6 0.2 round
}

proc second { } {
  variable vars

  set sz [expr {round(2.0*$vars(scaling))}]
  set v [expr {[clock format $vars(tm) -format %S]}]
  regsub {^0*(.)} $v {\1} v
  drawhand secondhand $v 60.0 15.0 red [pscale $sz] 0.9 0.05 round
}

proc tick { } {
  variable vars

  set vars(tm) [clock seconds]
  hour
  minute
  second
  after 200 ::tick
}

proc reconfigure { w args } {
  variable vars

  # windows sends many reconfigure .c events
  if { $w ne "." } {
    return
  }
  after cancel $vars(afterid)
  set vars(afterid) [after 100 _reconfigure]
}

proc _reconfigure { } {
  variable vars

  bind . <Configure> {}
  set sz [expr {min([winfo width .],[winfo height .])}]
  set t [expr {round(double($sz)/[tk scaling]*1.388888888)}]
  set r [expr {round($t/2.2)}]
  if { $vars(oldr) != $r } {
    drawClock $r
    set vars(oldr) $r
    # simplistic, will not handle right edge offsets.
    set g [wm geometry .]
    regsub {^\d+x\d+(.*)$} $g "${sz}x${sz}\\1" g
    wm geometry . $g
    update
  }
  bind . <Configure> [list ::reconfigure %W]
}

proc drawClock { basesz } {
  variable vars

  set vars(radius) [pscale $basesz]
  set vars(border) [pscale [expr {round(double($basesz)/10.0)}]]
  set vars(center) [expr {$vars(radius)+$vars(border)}]

  if { ! [winfo exists .c] } {
    set vars(canvas) [canvas .c \
        -background white \
        -highlightthickness 0 \
        ]
    pack $vars(canvas)
  } else {
    $vars(canvas) delete all
  }
  $vars(canvas) configure \
      -height [expr {$vars(radius)*2+$vars(border)*2}] \
      -width [expr {$vars(radius)*2+$vars(border)*2}]

  set vars(scaling) [expr {double($vars(radius))/100.0}]
  set sz [expr {round(12.0*$vars(scaling))}]
  font configure clockfont -size [expr {round([pscale $sz])}]

  $vars(canvas) create oval \
      $vars(border) $vars(border) \
      [expr {$vars(radius)*2+$vars(border)}] \
      [expr {$vars(radius)*2+$vars(border)}] \
      -fill grey95 \
      -width 0
  set inset [expr {round(15.0*$vars(radius)/100.0)}]
  for {set i 1} {$i <= 12} {incr i} {
    set deg [expr {(360.0/12.0) * (double($i)-3.0)}]
    set x [expr {round((double($vars(radius))-[pscale $inset]) * \
        cos($deg*0.0174533))+$vars(center)}]
    set y [expr {round((double($vars(radius))-[pscale $inset]) * \
        sin($deg*0.0174533))+$vars(center)}]
    set vars(lab.$i) [$vars(canvas) create text $x $y \
        -text $i \
        -font clockfont \
        -fill $vars(fgcol) \
        ]
  }
}

proc main { } {
  variable opts
  variable vars

  set vars(program.tag) clock

  set vars(fgcol) black
  set vars(oldr) 0
  . configure -background white
  wm title . {}

  font create clockfont
  set c [font actual TkDefaultFont]
  regsub -- {-size\s*\d+\s*} $c {} c
  font configure clockfont {*}$c

  set vars(afterid) {}
  drawClock 100
  update
  _reconfigure ; # does the initial bind
  wm protocol . WM_DELETE_WINDOW ::doexit
  ::tick
}
main
======

----
[Stu] 2007-10-01 Added missing backslashes to [ALM]'s clocks and [wdb]'s clock.


<<categories>> Example | Date and Time