[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_image] ====== ##+########################################################################## # # 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