---- [WikiDbImage horses.jpg] [Richard Suchenwirth] 2002-06-02 - After a long weekend with occasional fun projects, I finally wanted to do something in Tk too. Now here's a silly horse-racing game: ten horses (you can edit their names if you don't like my defaults) run at random speed from left to right. The first three to reach the finish are listed at the bottom. That's all. But still it was kind of fun to write, and at the usual fast Tcl speed - 2.5 hours between first design and this "delivery" version... ====== 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 . {exec wish $argv0 &; exit} main $horses ====== <> Games