Hosted by |
|
Scott Hess (shess at winternet.com) wrote this entertaining tclet. It demonstrates Tcl's flexible drawing capabilities. The clock uses a bezier curve anchored at four points -- the hour position, the minute position, the second position and the center of the clock -- to show the time. Click button-1 to switch between display modes, and click button-3 to switch between line thicknesses.
SourceHere's the source for the bezier clock (160 lines of code):
#!/bin/sh # The next line runs wish, while wish thinks the comment continues.\ exec wish $0 $@ # bclock # # Copyright 1996, Scott Hess, [email protected] or [email protected]. # Use as you will, just don't take credit for my work. # # This program is a Tk version of a clock program I originally # wrote for NeXTSTEP, years ago. The cute part was the use of a # bezier curve to draw the hands. To tell time, look at the # endpoints. The hour point is closer to the center, the minute # further out. You can't tell where the second hand belongs, unless # you really know your curves, but seconds don't count anyhow. # # There's no real user interface. Hack this file if you want to # change the defaults. Clicking Button-1 on the clock face switches # between clock types, clicking Button-3 modifies the drawing width. # The length of hands and tickmarks (from center), and the # width. These sizes will be scaled by scale. type gives the # hand-type, choose from types. array set hand { hour 0.40 minute 0.75 second 0.85 0 0.00 intick 0.95 outtick 1.00 width 0.15 scale 100 type bezier types {normal curve angle bezier} normal {minute 0 0 second 0 0 hour 0 0 minute} curve {minute 0 second 0 hour 0 minute} bezier {minute second 0 hour} angle {minute second second hour} tick {intick outtick} } # Calculate the set of points for the current hand type and # the angles in the passed array. proc hands {anglesName} { upvar $anglesName aa global hand set ss $hand(scale) set points {} foreach desc [set hand($hand(type))] { lappend points [expr {sin($aa($desc))*$hand($desc)*$ss+$ss}] lappend points [expr {$ss-cos($aa($desc))*$hand($desc)*$ss}] } return $points } # Calculate the angles for the second, minute, and hour hands, # and then update the .clock hands to match. proc setclock {hour minute second} { global hand set pi180 [expr {asin(1)/90.0}] set angles(0) 0 set angles(second) [expr {$second*6*$pi180}] set angles(minute) [expr {$minute*6*$pi180}] set angles(hour) [expr {$hour*30*$pi180+$angles(minute)/12}] set sector [expr {round($angles(second))}] switch $sector { 0 {.clock itemconfigure hands -fill AntiqueWhite4} 1 {.clock itemconfigure hands -fill green} 2 {.clock itemconfigure hands -fill blue} 3 {.clock itemconfigure hands -fill purple} 4 {.clock itemconfigure hands -fill red} 5 {.clock itemconfigure hands -fill yellow} 6 {.clock itemconfigure hands -fill bisque} default {.clock itemconfigure hands -fill white} } eval .clock coords hands [hands angles] } # Draw the clock for the current time, and reschedule. The # regsub is to prevent times like "08", which don't work in # expr, since leading 0 indicates octal. proc updateclock {} { after cancel updateclock set hms [clock format [clock seconds] -format "%I %M %S"] regsub -all "(^| )0" $hms "\\1" hms eval setclock $hms after 1000 updateclock } # Build the clock. Puts tickmarks every 30 degrees, tagged # "ticks", and prefill the "hands" line. proc buildclock {} { global hand set pi180 [expr {asin(1)/90.0}] catch {.clock delete marks} set hand(scale) [expr {[winfo width .clock]/2.0}] # This is a horrid hack. Use the hands procedure to # calculate the tickmark positions by temporarily changing # the clock type. set type $hand(type) set hand(type) tick for {set ii 0} {$ii<12} {incr ii} { set angles(intick) [expr {$ii*30*$pi180}] set angles(outtick) $angles(intick) eval .clock create line [hands angles] -tags {{ticks marks}} } set hand(type) $type .clock create line 0 0 0 0 -tags {hands marks} -smooth 1 .clock itemconfigure marks -capstyle round \ -width [expr {$hand(width)*$hand(scale)}] updateclock } # Increment the clock type. proc incrtype {} { global hand set ii [lsearch $hand(types) $hand(type)] incr ii if {$ii==[llength $hand(types)]} { set ii 0 } set hand(type) [lindex $hand(types) $ii] } # Increment the width of the hands. proc incrwidth {} { global hand set ii [expr {int($hand(width)*100.0)}] incr ii 5 if {$ii>25} { set ii 0 } set hand(width) [expr {$ii/100.0}] .clock itemconfigure marks -width [expr {$hand(width)*$hand(scale)}] } # Destroy an existing clock (useful when I was sourcing into # wish). catch {destroy .clock} # Create an elastic canvas to hold the clock, in a window that # stays square. canvas .clock -width 200 -height 200 pack .clock -expand 1 -fill both # Catch resize (Configure) to let us rescale the clock face. # Button-1 increments through the clock types, Button-3 increments # through the clock widths. bind . <Configure> "buildclock" bind . <Button-1> "incrtype" bind . <Button-3> "incrwidth" buildclock |