Updated 2012-01-14 21:24:13 by dkf

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 [1]).

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}

See also edit