Clock of Clocks

Keith Vetter 2017-09-09 : Here's yet another animated clock, see also Tk Dali Clock and Word Clock.
This one is a clock made out of 4x6 "pixels" where each "pixel" is a smaller clock with two hands. The hands rotate to create to create the digits for showing the time.
##+##########################################################################
#
# Clock of Clocks -- draws an animated clock where each pixel is itself a clock
# by Keith Vetter 2017-09-09
#
# https://codepen.io/RazvanDH/pen/ojLWOB
# https://www.reddit.com/r/oddlysatisfying/comments/6z3b22/a_clock/
#

package require Tk

set S(radius) 15
set S(diameter) [expr {2 * $S(radius)}]
set S(pixels,width) 4
set S(pixels,height) 6
set S(width) [expr {(6 * $S(pixels,width) + 2) * $S(diameter)}]
set S(height) [expr {$S(pixels,height) * $S(diameter)}]

set S(spin,size) 15
set S(spin,wait) 5

proc DoDisplay {} {
    global S

    wm title . "Clock of Clocks"
    wm resizable . 0 0
    destroy {*}[winfo child .]
    canvas .c -width $S(width) -height $S(height) -bd 0 -highlightthickness 0
    pack .c -side left

    set topleft [list 0 0]
    foreach tag {hour0 hour1 colon0 minute0 minute1 colon1 second0 second1} {
        set topleft [DrawDigitPixels {*}$topleft $tag]
    }
}

##+################################################################
#
# DrawDigitPixels -- draws the 4x6 grid of clock pixels
#
proc DrawDigitPixels {top left tag} {
    global S PIXELS
    set isColon [string match "colon*" $tag]
    set columns [expr {$isColon ? 1 : $S(pixels,width)}]
    for {set row 0} {$row < $S(pixels,height)} {incr row} {
        set y [expr {$top + $row * $S(diameter) + $S(radius)}]
        for {set col 0} {$col < $columns} {incr col} {
            set x [expr {$left + $col * $S(diameter) + $S(radius)}]
            set xy [Box $x $y $S(radius)]
            lassign $xy x0 y0 x1 y1
            set pixel "${tag}_${row}_${col}"
            set hand1 "${pixel}_hand1"
            set hand2 "${pixel}_hand2"
            .c create oval $xy -tag [list oval $pixel] -fill white -outline gray80 -width 2
            if {! $isColon} {
                .c create line $x $y $x1 $y -tag [list hand $hand1] -fill black -width 4 \
                    -capstyle projecting
                .c create line $x $y $x1 $y -tag [list hand $hand2] -fill black -width 4 \
                    -capstyle projecting
                set PIXELS($pixel,xy) [list $x $y]
                set PIXELS($pixel,hand1) 0
                set PIXELS($pixel,hand2) 0
            } elseif {$row == 2 || $row == 3} {
                set xy [Box $x $y [expr {$S(radius) / 2}]]
                .c create oval $xy -fill black
            }

        }
    }
    return [list $top [expr {$left + $S(diameter) * $columns}]]
}
proc Box {x y r} {
    return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]]
}
##+################################################################
#
# AngleXY -- returns coordinates for a hand at x0,y0 with given angle
#
proc AngleXY {x0 y0 angle} {
    lassign [SinCos $angle] dx dy
    return [list $x0 $y0 [expr {$x0 + $dx}] [expr {$y0 - $dy}]]
}
##+################################################################
#
# SinCos -- returns the sin and cos for a given angle, uses memoization
#
proc SinCos {angle} {
    if {[info exists ::MEM($angle)]} { return $::MEM($angle)}
    set rad [expr {$angle * acos(-1) / 180}]
    set x [expr {$::S(radius) * cos($rad)}]
    set y [expr {$::S(radius) * sin($rad)}]
    set ::MEM($angle) [list $x $y]
    return [list $x $y]
}

##+################################################################
#
# DrawHands -- moves the hands of the pixel to the value in PIXELS
#
proc DrawHands {pixel} {
    global PIXELS

    set angle1 $PIXELS($pixel,hand1)
    set angle2 $PIXELS($pixel,hand2)

    set hand1 "${pixel}_hand1"
    set hand2 "${pixel}_hand2"
    .c coords $hand1 [AngleXY {*}$::PIXELS($pixel,xy) $angle1]
    .c coords $hand2 [AngleXY {*}$::PIXELS($pixel,xy) $angle2]
}

##+################################################################
#
# NextTime -- sets the goal angles for every pixel to be for the
# specified time
#
proc NextTime {{time ""}} {
    global PIXELS
    set PIXELS(unsynced) {}

    if {$time eq ""} {
        set when [expr {[clock seconds] + 1}]
        set time [clock format $when -format "%I%M%S"]
    }
    set idx -1
    foreach digit {hour0 hour1 minute0 minute1 second0 second1} {
        incr idx
        set value [string index $time $idx]
        set unsynced [GoalDigit $digit $value]
        lappend PIXELS(unsynced) {*}$unsynced
    }
}
##+################################################################
#
# GoalDigit -- sets the goal angles for a single digit
#
proc GoalDigit {digit number} {
    global S FONT PIXELS

    set unsynced {}
    set idx -2
    for {set row 0} {$row < $S(pixels,height)} {incr row} {
        for {set col 0} {$col < $S(pixels,width)} {incr col} {
            incr idx 2
            set pixel "${digit}_${row}_${col}"

            lassign [lrange $FONT($number) $idx $idx+1] angle1 angle2
            set PIXELS($pixel,hand1,goal) $angle1
            set PIXELS($pixel,hand2,goal) $angle2
            if {$PIXELS($pixel,hand1) != $angle1 || $PIXELS($pixel,hand2) != $angle2} {
                lappend unsynced $pixel
            }
        }
    }
    return $unsynced
}
##+################################################################
#
# Animates -- runs our animation forever. Could be more efficient by
# only calling NextTime once a second but this works ok.
#
proc Animate {} {
    NextTime
    AnimateStep
    after $::S(spin,wait) Animate
}
##+################################################################
#
# AnimateStep -- updates all the clock pixels one step
#
proc AnimateStep {} {
    global PIXELS
    foreach arr $PIXELS(unsynced) {
        lassign [split $arr ","] pixel .
        foreach hand {hand1 hand2} direction {cw ccw} {
            set current $PIXELS($pixel,$hand)
            set goal $PIXELS($pixel,$hand,goal)
            set next [SpinHand $current $goal $direction]
            set PIXELS($pixel,$hand) $next
        }
        DrawHands $pixel
    }
}
##+################################################################
#
# SpinHand -- figures out new angle for a hand given where it is,
# where it want to go and which direction to spin.
#
proc SpinHand {current goal direction} {
    if {abs($current - $goal) < $::S(spin,size)} {return $goal}
    if {$direction eq "cw"} {
        set next [expr {$current + $::S(spin,size)}]
    } else {
        set next [expr {$current - $::S(spin,size)}]
    }
    if {$next >= 360} { set next [expr {$next - 360}] }
    if {$next < 0} { set next [expr {$next + 360}] }
    return $next
}

set mapping {x 225 u 90 d 270 l 180 r 0}
set FONT(0) [string map $mapping {
    d r l r l r l d
    u d d r l d u d
    u d u d u d u d
    u d u d u d u d
    u d u r l u u d
    u r l r l r l u
}]
set FONT(1) [string map $mapping {
    d r l r l d x x
    u r l d u d x x
    x x u d u d x x
    x x u d u d x x
    d r l u u r l d
    u r l r l r l u
}]
set FONT(2) [string map $mapping {
    d r l r l r l d
    u r l r l d u d
    d r l r l u u d
    u d d r l r l u
    u d u r l r l d
    u r l r l r l u
}]
set FONT(3) [string map $mapping {
    d r l r l r l d
    u r l r l d u d
    x x d r l u u d
    x x u r l d u d
    d r l r l u u d
    u r l r l r l u
}]
set FONT(4) [string map $mapping {
    d r l d d r l d
    u d u d u d u d
    u d u r l u u d
    u r l r l d u d
    x x x x u d u d
    x x x x u r l u
}]
set FONT(5) [string map $mapping {
    d r l r l r l d
    u d d r l r l u
    u d u r l r l d
    u r r l l d u d
    d r l r l u u d
    u r l r l r l u
}]
set FONT(6) [string map $mapping {
    d r l r l r l d
    u d d r l r l u
    u d u r l r l d
    u d d r l d u d
    u d u r l u u d
    u r l r l r l u
}]

set FONT(7) [string map $mapping {
    d r l r l r l d
    u r l r l d u d
    x x x x u d u d
    x x x x u d u d
    x x x x u d u d
    x x x x u r l u
}]
set FONT(8) [string map $mapping {
    d r l r l r l d
    u d d r l d u d
    u d u r l u u d
    u d d r l d u d
    u d u r l u u d
    u r l r l r l u
}]
set FONT(9) [string map $mapping {
    d r l r l r l d
    u d d r l d u d
    u d u r l u u d
    u r l r l d u d
    d r l r l u u d
    u r l r l r l u
}]

foreach aid [after info] {
    after cancel $aid
}

DoDisplay
Animate

return
Category Graphics
Category Application