Version 3 of klepsydra
Updated 2003-09-05 08:06:37Arjen Markus (4 september 2003) I first thought of calling this page "An ancient time measuring device", but I thought it a bit too much. A klepsydra is, indeed, a clock that works (or rather worked) on water. The idea is that due to the form of the vessel that holds the water (a paraboloid) the water flows out at a constant rate. This allowed the ancient Egyptians to measure time in a rough but adequate way.
The script below draws such a device and updates the time every five minutes. It being a crude device, the scale does not allow more accuracy than, say, half an hour. And the vessel needs to be filled from time to time. In this case: at six o'clock in the morning.
The artwork can be improved, but it was fun to work on it :)
# klepsydra.tcl --
# Draw an emptying klepsydra:
# - a paraboloid bowl filled with an orange fluid
# - a bucket underneath
# - on a gray table
# createScene --
# Create the basic scene (a canvas of 500 pixels heigh and wide)
#
# Arguments:
# None
# Result:
# None
# Side effects:
# The canvas is drawn with the table
#
proc createScene { } {
if { $::init } {
set ::init 0
canvas .cnv -width 500 -height 500 -bg white
pack .cnv -fill both
}
#
# The table
#
.cnv create polygon {30 490 420 490 470 410 80 410 30 490} \
-fill gray -outline darkgray
.cnv create polygon {30 490 420 490 420 500 30 500 30 490} \
-fill gray -outline darkgray
.cnv create polygon {420 490 470 410 470 500 420 500 420 490} \
-fill gray -outline darkgray
#
# The rest
#
fillKlepsydra
fillBucket
#
# Refresh after five minutes
#
after [expr {5*60*1000}] {
.cnv delete all
createScene
}
}
# fillKlepsydra --
# Fill the klepsydra according to the time of day
#
# Arguments:
# None
# Result:
# None
# Side effects:
# The paraboloid is drawn with an orange filling
#
proc fillKlepsydra { } {
global bottom
set nosegments 96 ;# ten-minute intervals over 16 hours
set totheight 320
set bottom [expr {40+$totheight}]
set maxradius 100
#
# Get the time (in hours)
#
set tod [clock format [clock seconds] -format "%H %M"]
scan $tod "%d %d" h m
set tod [expr {$h+$m/60.0}]
if { $tod < 6 } {
set level 0
} elseif { $tod > 22 } {
set level $nosegments
} else {
set level [expr {int($nosegments*($tod-6)/16.0)}]
}
for { set i 0 } { $i < $nosegments } { incr i } {
set height [expr {$totheight*(1.0-double($i)/$nosegments)}]
set nextheight [expr {$totheight*(1.0-double($i+1)/$nosegments)}]
set dh [expr {2.0*$height/30.0}]
set rad [expr {$maxradius*sqrt($height/$totheight)}]
set nextrad [expr {$maxradius*sqrt($nextheight/$totheight)}]
if { $i >= $level } {
.cnv create polygon \
[expr {250-$rad}] [expr {$bottom-$height}] \
[expr {250-$nextrad}] [expr {$bottom-$nextheight}] \
[expr {250+$nextrad}] [expr {$bottom-$nextheight}] \
[expr {250+$rad}] [expr {$bottom-$height}] \
[expr {250-$rad}] [expr {$bottom-$height}] \
-fill orange -outline orange
}
if { $i == $level } {
.cnv create oval [expr {250-$rad}] [expr {$bottom-$height+$dh}] \
[expr {250+$rad}] [expr {$bottom-$height-$dh}] \
-outline bisque -fill bisque -tag surface
}
.cnv create line [expr {250+$rad}] [expr {$bottom-$height}] \
[expr {250+$nextrad}] [expr {$bottom-$nextheight}] \
-tag klepsydra
.cnv create line [expr {250-$rad}] [expr {$bottom-$height}] \
[expr {250-$nextrad}] [expr {$bottom-$nextheight}] \
-tag klepsydra
.cnv create line [expr {250+$rad}] [expr {$bottom-$height}] \
[expr {250+$nextrad}] [expr {$bottom-$nextheight}] \
-tag klepsydra
if { $i%6 == 0 } {
if { $i > 0 } {
set width 1
if { $i == 12 } {
set width 5
.cnv create line [expr {250+$rad}] [expr {$bottom-$height}] \
430 [expr {$bottom-$height}] \
430 450 \
-width $width -fill black
.cnv create oval 420 445 440 455 -fill black
}
.cnv create arc [expr {250-$rad}] [expr {$bottom-$height+$dh}] \
[expr {250+$rad}] [expr {$bottom-$height-$dh}] \
-start 180 -extent 180 -width $width \
-outline black -tag klepsydra -style arc
.cnv create arc [expr {250-$rad}] [expr {$bottom-$height+$dh}] \
[expr {250+$rad}] [expr {$bottom-$height-$dh}] \
-start 0 -extent 180 -width $width \
-outline gray -tag klepsydra_back -style arc
} else {
.cnv create oval [expr {250-$rad}] [expr {$bottom-$height+$dh}] \
[expr {250+$rad}] [expr {$bottom-$height-$dh}] \
-outline black -tag klepsydra
}
.cnv create text [expr {230-$rad}] [expr {$bottom-$height}] \
-text "[expr {6+$i/6}]:00"
}
}
.cnv create text [expr {230-$nextrad}] [expr {$bottom-$nextheight}] \
-text "[expr {6+$nosegments/6}]:00"
#
# The final touch: a thin jet of fluid ...
#
if { $level < $nosegments } {
.cnv create line 250 $bottom 250 450 -fill orange -width 2 \
-tag jet
}
.cnv raise surface
.cnv raise klepsydra_back
.cnv raise klepsydra
}
# fillBucket --
# Fill the bucket appropriately
#
# Arguments:
# None
# Result:
# None
# Side effects:
# The canvas is drawn with the table and the outlines of the
# bowl and bucket.
#
proc fillBucket { } {
global bottom
#
# Get the time (in hours)
#
set tod [clock format [clock seconds] -format "%H %M"]
scan $tod "%d %d" h m
set tod [expr {$h+$m/60.0}]
if { $tod < 6 } {
set level 0
} elseif { $tod > 22 } {
set level 45
} else {
set level [expr {int(45*($tod-6)/16.0)}]
}
#
# The fluid
#
.cnv create rectangle 100 450 400 [expr {450-$level}] \
-fill orange -outline orange
.cnv create oval {100 470 400 430} -fill orange
.cnv create oval 100 [expr {450-$level+20}] \
400 [expr {450-$level-20}] \
-fill bisque -outline black
#
# The bucket
# Note: arc with coordList does not handle -extent 180!
#
.cnv create line {100 450 100 405} -fill black -tag bucket
.cnv create line {400 450 400 405} -fill black -tag bucket
.cnv create arc 100 470 400 430 -start 180 -extent 180 \
-tag bucket -outline black -style arc
.cnv create arc 100 470 400 430 -start 0 -extent 180 \
-tag bucket -outline darkgray -style arc
.cnv create arc 100 425 400 385 -start 92 -extent 356 \
-tag bucket -outline black -style arc
.cnv coords jet [list 250 $bottom 250 [expr {450-$level}]]
.cnv raise jet
}
#
# Main code
#
set ::init 1
createScene