package require Tk
pack [canvas .c -width 240 -height 280 -background green3]
.c create rect 40 20 200 260 -width 2 -outline white
.c create rect 70 20 170 70 -width 2 -outline white
.c create rect 90 20 150 40 -width 2 -outline white
set g1 [.c create rect 105 5 135 20 -fill red -stipple gray25 -tag goal]
set n$g1 0
.c create text 15 120 -tag n$g1
trace var n$g1 w ".c itemconfig n$g1 -text \[set ::n$g1\];#"
set n$g1 0
.c create rect 70 215 170 260 -width 2 -outline white
.c create line 40 140 200 140 -width 2 -fill white
.c create rect 90 240 150 260 -width 2 -outline white
set g2 [.c create rect 105 260 135 275 -fill red -stipple gray25 -tag goal]
.c create text 15 150 -tag n$g2
trace var n$g2 w ".c itemconfig n$g2 -text \[set ::n$g2\];#"
set n$g2 0
.c create oval 95 115 145 165 -width 2 -outline white
.c create oval 115 135 125 145 -fill yellow -tag ball
bind .c <1> {down %W %x %y}
bind .c <B1-Motion> {motion %W %x %y}
proc down {w x y} {
set ::X $x; set ::Y $y
foreach {bx by} [center $w ball] break
set dx [expr {$bx-$x}]
set dy [expr {$by-$y}]
if {hypot($dx,$dy)<20} {
move $w ball [expr {$dx*0.6}] [expr {$dy*0.6}]
}
}
proc motion {w x y} {
$w move ball [expr {$x-$::X}] [expr {$y-$::Y}]
set ::X $x; set ::Y $y
}
proc center {w tag} {
foreach {x0 y0 x1 y1} [$w bbox $tag] break
list [expr {($x0+$x1)/2.}] [expr {($y0+$y1)/2.}]
}
proc move {w tag dx dy} {
if {abs($dx)<1 && abs($dy)<1} return
foreach {bx by} [center $w ball] break
if {$bx<30 || $bx>210 || $by<10 || $by>270} return
$w move $tag $dx $dy
foreach {bx by} [center $w ball] break
foreach goal [$w find withtag goal] {
foreach {x0 y0 x1 y1} [$w bbox $goal] break
if {$bx>$x0 && $bx<$x1 && $by>$y0 && $by<$y1} {
goal $w $goal
return
}
}
after 50 [list move $w $tag [expr {$dx*0.8}] [expr {$dy*0.8}]]
}
proc goal {w tag} {
incr ::n$tag
foreach i {1 2 3} {
$w itemconfig $tag -fill white -stipple {}
update
after 100
$w itemconfig $tag -fill black -stipple {}
update
after 100
}
$w itemconfig $tag -fill red -stipple gray25
}
bind . <Escape> {exec wish $argv0 &; exit}NEM: Nice! 5-a-side might be better for the little screen. Could make a nice test-bed for software RoboCup [1] implementations.RS just added goal detection and counting :) - fixed distance measurement to use hypot().
JM Richard, I knew you would not resist the temptation to write some soccer little toy... good luck Germany !
[unperson] Yes good luck Brazil! :-) What in the world is the algorithm for these soccer, hockey games on Nintendo and on Windows? Do they operate on the basis of a section? If the ball is in a section, player A assigned to the section rushes and kicks the ball? Anyone knows how this thing works in terms of algorithm?
