package require Tk set horses {
Blaise Gottlieb Animal Ada Alan Haskell Grace Brian John Linus
} ;# edit this list for permanent preferences proc main {horses} {
set c [canvas .c -bg green4 -width 500 -height 330]
pack $c
set n 0
foreach horse $horses {
set w [entry $c.e$n -textvar horse$n -width 8 -bg green3]
set ::horse$n $horse
$c create window 5 [expr $n*30+5] -window $w -anchor nw
horse $c 70 [expr $n*30+14] horse$n
lappend horsetags horse$n
incr n
}
$c create line 480 0 480 330 -fill white -tag finish
button $c.button -text Start -pady 0 -width 7 \
-command [list start $c $horsetags]
$c create window 5 [expr $n*30] -window $c.button -anchor nw
label $c.winners -textvar winners -bg green3 -width 60
$c create window 70 [expr $n*30] -window $c.winners -anchor nw} proc horse {c x y tag} {
set hide [lpick {black brown white gray brown3 brown4}]
set c1 [lpick {red yellow blue purple pink green}]
set c2 [lpick {red yellow blue purple pink green}]
$c create oval 0 -1 18 4 -fill $hide -outline $hide -tag $tag
$c create line 1 12 3 0 5 12 -fill $hide -tag $tag -width 2
$c create line 15 12 17 0 19 12 -fill $hide -tag $tag -width 2
$c create line 16 0 20 -7 24 -5 -fill $hide -tag $tag -width 3
# Jockey:
$c create line 9 4 11 1 7 -1 -fill $c1 -width 2 -tag $tag
$c create line 7 -2 10 -6 15 -3 -fill $c2 -width 2 -tag $tag
$c create oval 9 -7 12 -10 -fill orange -outline orange -tag $tag
$c move $tag $x $y} proc start {c running} {
$c.button config -text Reset -command [list reset $c $running]
global winners
set winners {}
set finish [expr [lindex [$c bbox finish] 2]+10]
while {[llength $winners]<3} {
set this [lpick $running]
$c move $this [lpick {0 1 2 3}] 0
update
if {[lindex [$c bbox $this] 2]>$finish} {
lappend winners [expr [llength $winners]+1]:[set ::$this]
lremove running $this
}
}}