Arjen Markus (1 november 2024) Time flies and is unrelenting. This is even more so because our clocks usually present it in a monotonically progressing fashion: numbers that increase at a constant pace - ignoring of course the turn of the hour or of the day - and the hands of an analogous clock that turn around and around. To make this relentlessness a bit less relentless, I constructed a rather whimsical or downright silly version.
I was inspired by a magnificent clock I saw in Vienna during a recent short holiday - https://www.visitingvienna.com/sights/ankeruhr-anchor-clock/ . It is mechanical with figures slowly moving from the left to the right, emphasizing the relentlessness of Time. My clock uses a circular display and moving parts too. But in a different fashion ...
(It might be an interesting exercise to use TclBlend for this toy as well.)
# sillyclock.tcl -- # Create a whimsical/silly clock: # - The twelve sections (pie slices) have different colours # - Each minute they rotate in a random fashion to a new position # - The hour hand is a black pie slice with a smaller radius # - The minute hand is a thinner black pie slice with a larger radius # # pack [canvas .c -width 600 -height 600] # # Set up the clock # set idx 0 set hour_radius 220 set centre 300 set torad [expr {acos(-1.0)/180.0}] # # Global variables for repositioning the sections # set section {} ;# Canvas IDs of the sections set hour {} ;# Canvas IDs of the hour indications set position {} ;# Current position of the sections set new_position {} ;# New positions of the sections set hour_hand "" ;# Canvas ID of the hour hand set minute_hand "" ;# Canvas ID of the minute hand foreach colour {blue lightblue green lime yellow orange red magenta brown cyan purple lightgrey} { set angle [expr {15 + 30 * $idx}] lappend section [.c create arc 100 100 500 500 -start [expr {30*$idx}] -extent 30 -style pieslice -fill $colour] lappend hour [.c create text [expr {$centre + $hour_radius * cos($torad * $angle)}] [expr {$centre - $hour_radius * sin($torad * $angle)}] \ -text [expr {$idx+1}] -font "Helvetica 12 italic"] lappend position $idx incr idx } set hour_hand [.c create arc 200 200 400 400 -start [expr {30*$idx}] -extent 30 -style pieslice -fill black] set minute_hand [.c create arc 90 90 510 510 -start [expr {10 + 30*$idx}] -extent 10 -style pieslice -fill black] # determine_new_position -- # Calculate a new position for the sections # # Arguments: # None # # Side effects: # proc determine_new_position {} { global new_position set possible {0 1 2 3 4 5 6 7 8 9 10 11} set new_position {} while { [llength $possible] > 0 } { set random [expr {int( [llength $possible] * rand() )}] lappend new_position [lindex $possible $random] set possible [lreplace $possible $random $random] } } # rotate_sections -- # Rotate the sections to the new position # # Arguments: # None # # Side effects: # The sections are rotated over a small angle, but this is repeated # via an [after] command. In total 144 steps are taken over roughly 12 seconds # proc rotate_sections {step} { global section hour position new_position hour_hand minute_hand centre hour_radius torad foreach s $section h $hour p $position n $new_position { set new_start [expr {30 * $p + 30 * $step * ($n - $p) / 144}] .c itemconfigure $s -start $new_start set angle [expr {15 + $new_start}] .c coords $h [expr {$centre + $hour_radius * cos($torad * $angle)}] [expr {$centre - $hour_radius * sin($torad * $angle)}] } if { $step < 144 } { after [expr {12000 / 144}] [list rotate_sections [incr step]] } else { # # Completed, so update the position # set position $new_position # # Move the hands to the correct position # set h [clock format [clock seconds] -format "%l"] ;# Avoid "08" as the outcome, use a 12-hour clock scan [clock format [clock seconds] -format "%M"] %d m ;# No equivalent for minutes set h [expr {($h-1) % 12}] set m [expr {$m / 5}] set h [lindex $position $h] set m [lindex $position $m] .c itemconfigure $hour_hand -start [expr {30 * $h}] .c itemconfigure $minute_hand -start [expr {10 + 30 * $m}] } } # check_time -- # Check whether we are crossing over to a new minute # # Arguments: # None # # Side effects: # If a new minute has arrived, then start the motion of the sections # # Note: # We need to make sure that the second that triggers the re-positioning # has passed before we examine the system time again # proc check_time {} { set time [expr {[clock seconds] % 60}] if { $time == 0 } { determine_new_position rotate_sections 0 after 2000 check_time } else { after 100 check_time } } # # Get the clock started # determine_new_position rotate_sections 0 check_time