Pocket Soccer
Richard Suchenwirth 2006-06-13 - I'm not a soccer enthusiast, but as the topic is always in the news during the current World Cup, I could not avoid it, and so I thought how to bring Tcl/Tk into the game :^)
So far the game, designed in geometry to be playable on PocketPC is very crude. You have the field, the ball, and no single player except your mouse pointer. (On a touch screen, two players can of course have a battle of fingers :-) If you click close to the ball, you'll kick it in that direction. You can also click on the ball itself and drag it around if you want.
Feel free to add more life to this - e.g. 22 little players running around would make the thing a little bit more realistic...
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 add variable n$g1 write ".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 add variable n$g2 write ".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
lassign [center $w ball] bx by
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} {
lassign [$w bbox $tag] x0 y0 x1 y1
list [expr {($x0+$x1)/2.}] [expr {($y0+$y1)/2.}]
}
proc move {w tag dx dy} {
if {abs($dx)<1 && abs($dy)<1} return
lassign [center $w ball] bx by
if {$bx<30 || $bx>210 || $by<10 || $by>270} return
$w move $tag $dx $dy
lassign [center $w ball] bx by
foreach goal [$w find withtag goal] {
lassign [$w bbox $goal] x0 y0 x1 y1
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 [L1 ] 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?