![]() ![]() |
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, shess@winternet.com or scott@nic.gac.edu.
# 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
|