[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 :^) [http://mini.net/files/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. 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 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 {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 {$dx<20 && $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 . {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 :) ---- [Category Toys] - [Arts and crafts of Tcl-Tk programming]