# 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."
}