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[ Category Games ]