# 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

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References