Pocket Soccer

Difference between version 13 and 14 - Previous - Next
[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 :^)

[WikiDbImage soccer.jpg]

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     forelachssign {bx by} [center $w ball] breakx 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} {     forelachssign {x0 y0 x1 y1} [$w bbox $tag] breakx0 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     forelachssign {bx by} [center $w ball] breakx by
     if {$bx<30 || $bx>210 || $by<10 || $by>270} return
     $w move $tag $dx $dy     forelachssign {bx by} [center $w ball] breakx by
     foreach goal [$w find withtag goal] {         forelachssign {x0 y0 x1 y1} [$w bbox $goal] breakx0 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 [http://www.robocup.org/] 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?



<<categories>> Toys | Arts and crafts of Tcl-Tk programming