Arjen Markus Not quite perfect, but I intend it as an example for my Young Programmers' Project [L1 ] and I did not want to cloud the code with lots of details.
This is a colourful resurrection of the first graphical game for home enertainment that I have seen. Use the cursor keys to move the green rectangle (the "keeper" in the code). No way to influence the speed - but that is going to be an exercise in that chapter...
# pingpong.tcl -- # Play the "ancient" game of PingPong # package require Tk # createField -- # Create the playing field and the score board # Arguments: # None # Result: # None # Side effects: # Filling the state array and creating the canvas to play on # proc createField { } { global ppdata set ppdata(width) 300 set ppdata(height) 200 set ppdata(keeper_height) 20 canvas .c -width $ppdata(width) -height $ppdata(height) \ -background white pack .c -fill both # # Note: the vertical coordinate increases from top to bottom # set htop [expr {($ppdata(height)-$ppdata(keeper_height))/2}] set hbottom [expr {($ppdata(height)+$ppdata(keeper_height))/2}] set ppdata(keeper_ymin) \ [expr {$ppdata(keeper_height)/2}] set ppdata(keeper_ymax) \ [expr {$ppdata(height)-$ppdata(keeper_height)/2}] set ppdata(keeper_ystep) \ [expr {$ppdata(keeper_height)/3}] set wleft 5 set wright 15 set ppdata(keeper_right) $wright set ppdata(keeper_y) [expr {$ppdata(height)/2}] set ppdata(keeper) \ [.c create rectangle $wleft $htop $wright $hbottom \ -outline black -fill forestgreen] set wleft [expr {$ppdata(width)-20}] set wright [expr {$ppdata(width)-10}] set htop [expr {$ppdata(height)/2-5}] set hbottom [expr {$ppdata(height)/2+5}] set ppdata(ball_x) $wleft set ppdata(ball_y) $ppdata(keeper_y) set ppdata(ball_xinit) $wleft set ppdata(ball_yinit) $ppdata(keeper_y) # # Initialise the ball # set ppdata(ball) \ [.c create oval $wleft $htop $wright $hbottom \ -outline black -fill yellow] set ppdata(ball_speed) 5.0 newBall set wleft [expr {$ppdata(width)-$ppdata(keeper_height)-5}] set wright [expr {$ppdata(width)-5}] set htop [expr {($ppdata(height)-$ppdata(keeper_height))/2}] set hbottom [expr {($ppdata(height)+$ppdata(keeper_height))/2}] set ppdata(shooter) \ [.c create oval $wleft $htop $wright $hbottom \ -outline black -fill purple] frame .frm label .frm.keeper -textvariable ppdata(keeper_score) \ -font "helvetica 20" label .frm.shooter -textvariable ppdata(shooter_score) \ -font "helvetica 20" label .frm.inbetween -text " " \ -font "helvetica 20" button .frm.reset -text "Reset" -command resetScore -width 10 button .frm.exit -text "Exit" -command exit -width 10 set ppdata(keeper_score) 0 set ppdata(shooter_score) 0 pack .frm -fill x -side bottom grid .frm.keeper .frm.inbetween .frm.shooter grid .frm.reset x .frm.exit bind .c <Key-Up> {moveKeeper up} bind .c <Key-Down> {moveKeeper down} # # Let the canvas have the input focus, otherwise the keeper # can not be moved # focus .c wm focus . } # moveKeeper -- # Move the keeper up or down # Arguments: # dir Direction in which to move the rectangle # Result: # None # Side effects: # The rectangle is moved up or down (if possible) # proc moveKeeper { dir } { global ppdata if { $dir == "up" } { if { $ppdata(keeper_y) > $ppdata(keeper_ymin) } { incr ppdata(keeper_y) -$ppdata(keeper_ystep) .c move $ppdata(keeper) 0 -$ppdata(keeper_ystep) } } if { $dir == "down" } { if { $ppdata(keeper_y) < $ppdata(keeper_ymax) } { incr ppdata(keeper_y) $ppdata(keeper_ystep) .c move $ppdata(keeper) 0 $ppdata(keeper_ystep) } } } # moveBall -- # Move the ball to the left (note: it bounces off the wall and the # keeper) # Arguments: # None # Result: # None # Side effects: # The ball is moved, possibly either score is increased # proc moveBall { } { global ppdata if { $ppdata(ball_x) > 0 } { .c move $ppdata(ball) $ppdata(ball_xstep) $ppdata(ball_ystep) foreach {xmin ymin xmax ymax} [.c coords $ppdata(ball)] {break} set ppdata(ball_x) [expr {($xmin+$xmax)/2.0}] set ppdata(ball_y) [expr {($ymin+$ymax)/2.0}] #set ppdata(ball_x) [expr {$ppdata(ball_x)+$ppdata(ball_xstep)}] #set ppdata(ball_y) [expr {$ppdata(ball_y)+$ppdata(ball_ystep)}] } else { # # The keeper has missed, "new" ball # incr ppdata(shooter_score) newBall } # # Reflection off the top wall # if { $ppdata(ball_y) < 0 } { set ppdata(ball_y) [expr {-$ppdata(ball_y)}] set ppdata(ball_ystep) [expr {-$ppdata(ball_ystep)}] .c move $ppdata(ball) 0 $ppdata(ball_ystep) } # # Reflection off the bottom wall # if { $ppdata(ball_y) > $ppdata(height) } { set dy [expr {$ppdata(height)-$ppdata(ball_y)}] set ppdata(ball_y) [expr {2.0*$ppdata(height)-$ppdata(ball_y)}] set ppdata(ball_ystep) [expr {-$ppdata(ball_ystep)}] .c move $ppdata(ball) 0 $dy } # # Reflection off the keeper: # - let the ball go on for another two seconds, then move it to the # initial position # if { $ppdata(ball_x) < $ppdata(keeper_right)+2 } { if { abs($ppdata(keeper_y)-$ppdata(ball_y)) < 10 } { set ppdata(ball_x) \ [expr {2*$ppdata(keeper_right)-$ppdata(ball_x)}] set ppdata(ball_xstep) [expr {-$ppdata(ball_xstep)}] .c move $ppdata(ball) $ppdata(ball_xstep) 0 incr ppdata(keeper_score) after 2000 newBall } } after 50 moveBall } # newBall -- # Shoot a new ball # Arguments: # None # Result: # None # Side effects: # The ball is moved back to the initial position, it is given a new # direction # proc newBall { } { global ppdata set dx [expr {$ppdata(ball_xinit)-$ppdata(ball_x)}] set dy [expr {$ppdata(ball_yinit)-$ppdata(ball_y)}] .c move $ppdata(ball) $dx $dy set angle [expr {3.1415926*(1.0+(0.5-rand())/2.0)}] set ppdata(ball_x) [expr {$ppdata(ball_x)+$dx}] set ppdata(ball_y) [expr {$ppdata(ball_y)+$dy}] set ppdata(ball_xstep) [expr {$ppdata(ball_speed)*cos($angle)}] set ppdata(ball_ystep) [expr {$ppdata(ball_speed)*sin($angle)}] } # resetScore -- # Reset the score (simply set the two variables to zero) # keeper) # Arguments: # None # Result: # None # Side effects: # The score variables are set to zero # proc resetScore { } { global ppdata set ppdata(keeper_score) 0 set ppdata(shooter_score) 0 } # # The main loop: set up the field and go # createField after 100 moveBall
xmav000 not quite perfect, but if you are a player and if you want, you might try to "catch" the ball and getting lots of points at once. to do so you hit the ball with the top or the bottom side of the green box. with a bit practise you can keep the ball within the green box for a short time by moving the box in the direction the ball wants to go. I did reach 37 points at once a few times. dont know what limits this. anyone gets higher? :)
AM Theoretically, you can reach 40: after the first collision, the ball remains in the neighbourhood for another 2 seconds and the position (and score) is updated with 50 ms intervals. But I will fix this!!!!
(Well, on my YPP page, that is! :)