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