[Arjen Markus] Not quite perfect, but I intend it as an example for my Young Programmers' Project [http://tcl.projectforum.com/young] 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! :)

<<categories>> Games