Version 6 of TkPong

Updated 2009-07-10 06:02:26 by hectorfh

Héctor Francisco Hernández 2009-07-10 - Just another pong!

To control the pads use 'q', 'a', 'p' and 'l' keys.

---

 # Copyright (c) 2008, 2009 Héctor Francisco Hernández <[email protected]>

 # Permission to use, copy, modify, and/or distribute this software for any
 # purpose with or without fee is hereby granted, provided that the above
 # copyright notice and this permission notice appear in all copies.

 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

 package require Tk

 canvas .canvas -width 520 -height 390 -bg green4
 label .lblbtm -textvariable lblbtm
 pack .canvas
 pack .lblbtm -fill x

 .canvas create rectangle 10 156 25 234 -tag pad1 -fill gray -outline gray
 .canvas create rectangle 495 156 510 234 -tag pad2 -fill gray -outline gray
 .canvas create oval 255 190 265 200 -tag ball -fill white -outline white

 wm title . "tkpong"
 wm protocol . WM_DELETE_WINDOW exit

 bind . <Escape> exit
 bind . <KeyPress-q> {set pad1ay -0.001}
 bind . <KeyPress-a> {set pad1ay 0.001}
 bind . <KeyRelease-q> {set pad1ay 0}
 bind . <KeyRelease-a> {set pad1ay 0}
 bind . <KeyPress-p> {set pad2ay -0.001}
 bind . <KeyPress-l> {set pad2ay 0.001}
 bind . <KeyRelease-p> {set pad2ay 0}
 bind . <KeyRelease-l> {set pad2ay 0}

 while 1 {
   set pad1y 195
   set pad1ay 0
   set pad1vy 0
   set pad2y 195
   set pad2ay 0
   set pad2vy 0
   set plyr1pts 0
   set plyr2pts 0

   set lblbtm "Press \"Return\" to start or \"Esc\" to exit."
   bind . <Return> {set sleep {}}
   tkwait variable sleep
   bind . <Return> {}

   while {10 > $plyr1pts && 10 > $plyr2pts} {
     set n 0
     set ballx 260
     set bally 195
     set ballvx [expr {rand () < 0.5 ? -0.2 : 0.2}]
     set ballvy [expr {rand () * 0.1 - 0.05}]

     set lblbtm "$plyr1pts - $plyr2pts"

     while {-5 < $ballx && 525 > $ballx} {
       set pad1vy [expr {0 < $pad1y && 390 > $pad1y \
           || 0 >= $pad1y && 0 <= $pad1vy && 0 < $pad1ay \
           || 390 <= $pad1y && 0 >= $pad1vy && 0 > $pad1ay \
           ? $pad1vy + $pad1ay : 0}]
       set pad1y [expr {$pad1y + $pad1vy}]

       set pad2vy [expr {0 < $pad2y && 390 > $pad2y \
           || 0 >= $pad2y && 0 <= $pad2vy && 0 < $pad2ay \
           || 390 <= $pad2y && 0 >= $pad2vy && 0 > $pad2ay \
           ? $pad2vy + $pad2ay : 0}]
       set pad2y [expr {$pad2y + $pad2vy}]

       set ballx [expr {$ballx + $ballvx}]
       set bally [expr {$bally + $ballvy}]

       set ballvy [expr {5 > $bally && 0 > $ballvy
         || 385 < $bally && 0 < $ballvy ? -$ballvy : $ballvy}]

       if {25 > $ballx && 20 < $ballx && 0 > $ballvx} {
         if {$pad1y - 45 < $bally && $pad1y + 45 > $bally} {
           set ballvx [expr {-$ballvx + 0.01}]
           set ballvy [expr {$ballvy + ($bally - $pad1y) / 45.0 * 0.15 + \
               $pad1vy * 0.4}]
         }
       } elseif {500 > $ballx && 495 < $ballx && 0 < $ballvx} {
         if {$pad2y - 45 < $bally && $pad2y + 45 > $bally} {
           set ballvx [expr {-$ballvx - 0.01}]
           set ballvy [expr {$ballvy + ($bally - $pad2y) / 45.0 * 0.15 + \
               $pad2vy * 0.4}]
         }
       }

       if {0 == $n % 20} {
         .canvas coords pad1 10 [expr {$pad1y - 39}] 25 [expr {$pad1y + 39}]
         .canvas coords pad2 495 [expr {$pad2y - 39}] 510 [expr {$pad2y + 39}]
         .canvas coords ball [expr {$ballx - 5}] [expr {$bally - 5}] \
             [expr {$ballx + 5}] [expr {$bally + 5}]

         after 20 {set sleep {}}
         tkwait variable sleep
       }

       incr n
     }

     set plyr1pts [expr {525 < $ballx ? $plyr1pts + 1 : $plyr1pts}]
     set plyr2pts [expr {-5 > $ballx ? $plyr2pts + 1 : $plyr2pts}]

   }

   tk_messageBox -parent . -title "Congratulations!" \
       -message "Player [expr {10 == $plyr1pts ? "one" : "two"}] wins."
 }

---