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
        }
    }
}
proc reset {c tags} {
    $c.button config -text Start -command [list start $c $tags]
    foreach i $tags {
        set x [lindex [$c bbox $i] 0]
        $c move $i [expr {60-$x}] 0
    }
}
proc lpick L {lindex $L [expr int(rand()*[llength $L])]}
proc lremove {listName what} {
    upvar 1 $listName list
    set pos  [lsearch $list $what]
    set list [lreplace $list $pos $pos]
}
bind . <space> {exec wish $argv0 &; exit}
main $horses