[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

----
[[
[Category Games]
]]