A base-5 clock
Richard Suchenwirth 2004-12-23 - Here is the Tk simulation of an unusual clock found since 1975 in Berlin, Germany (it used to stand in the middle of the Kurfürstendamm, and now has moved to the Europa Center - German description at [L1 ]).
The popular name is "Mengenlehreuhr" ("set theory clock"), but it has little to do with set theory - it just displays hours and minutes in a sort of base-5 system. The round lamp on top just blinks to indicate the thing is running. The first row shows how many 5-hour blocks have passed since midnight; the second, how many hours in the current 5-hr block; the third, how many 5-minute blocks since the hour (the red lights marking quarter-hours); the bottom row finally indicates how many minutes in the current 5-minutes block. With little practice this clock can be easily read (the screenshot was at 14:57, like on the photo).
As there were many for loops to write, I decided to use this oversimplified loop construct instead:
proc loop {from to body} {
upvar 1 i i ;# make index visible in body
for {set i $from} {$i<$to} {incr i} {uplevel 1 $body}
}
#-- And likewise, a shortcut for addition:
proc + {a b} {expr {$a+$b}}
#-- This procedure turns on the lights as befitting the time:
proc update'clock w {
set fill [expr {[$w itemcget S -fill] eq "orange"?
"orange4": "orange"}]
$w itemconfig S -fill $fill
scan [clock format [clock sec] -format %H] %d hour
$w itemconfig lp -fill red4
loop 0 [expr $hour/5] {$w itemconfig H$i -fill red}
loop 0 [expr $hour%5] {$w itemconfig h$i -fill red}
scan [clock format [clock sec] -format %M] %d minute
loop 0 [expr $minute/5] {
$w itemconfig M$i -fill [expr {$i%3==2? "red": "orange"}]
}
loop 0 [expr $minute%5] {$w itemconfig m$i -fill orange}
}
#-- The indispensable [every] timer:
proc every {ms body} {eval $body; after $ms [info level 0]}
#--- Now for the UI, and "online help":
set about {Model of a base-5 clock in Berlin
Richard Suchenwirth 2004
Powered by Tcl/Tk!
First row: 5-hour blocks
Second row: Hours
Third row: 5-minute blocks
Fourth row: Minutes}
pack [canvas .c -width 140 -height 200]
button .c.b -text " ? " -command {tk_messageBox -message $about}
.c create window 125 15 -window .c.b
#-- The clock case has a complex shape (corners should be rounded)
set x1 7; set x2 24; set x3 120; set x4 139
set y1 47; set y2 78; set y3 87; set y4 118; set y5 127
set y6 158; set y7 167; set y8 198
.c create poly $x1 $y1 60 $y1 71 18 85 $y1\
$x4 $y1 $x4 $y2 $x3 $y2 $x3 $y3 $x4 $y3 $x4 $y4 \
$x3 $y4 $x3 $y5 $x4 $y5 $x4 $y6 $x3 $y6 $x3 $y7 $x4 $y7 $x4 $y8 \
$x1 $y8 $x1 $y7 $x2 $y7 $x2 $y6 $x1 $y6 $x1 $y5 $x2 $y5 $x2 $y4 \
$x1 $y4 $x1 $y3 $x2 $y3 $x2 $y2 $x1 $y2 $x1 $y1 -fill grey80 \
-outline black
#-- holes in the clock case
set xa 52; set xb 91
.c create rect $xa $y2 $xb $y3 -fill grey
.c create rect $xa $y4 $xb $y5 -fill grey
.c create rect $xa $y6 $xb $y7 -fill grey
#-- Second light on top
.c create oval 53 4 93 44 -fill grey80
.c create oval 57 8 89 40 -tag S -fill orange
#-- Hour lights
set x 10
loop 0 4 {
.c create rect $x 50 [+ $x 29] 75 -tag "lp H$i" -fill red
incr x 32
}
set x 10
loop 0 4 {
.c create rect $x 90 [+ $x 29] 115 -tag "lp h$i" -fill red
incr x 32
}
#-- Minute lights
set x 10
loop 0 11 {
set fill [expr {$i%3==2? "red" : "orange"}]
.c create rect $x 130 [+ $x 9] 155 -tag "lp M$i" -fill $fill
set x [+ $x 11.5]
}
set x 10
loop 0 4 {
.c create rect $x 170 [+ $x 29] 195 -tag "lp m$i" -fill orange
incr x 32
}
#-- and finally, get the clock to tick:
every 1000 {update'clock .c}
bind . <Escape> {exec wish $argv0 &; exit}