Version 0 of finalhorses

Updated 2019-02-19 09:58:04 by acorn54
This page is considered SPAM!
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
        }
    }
}