TkPong

Difference between version 12 and 19 - Previous - Next
Héctor Francisco Hernández 2009-07-10 - Just another pong!

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

[http://1.bp.blogspot.com/_FDA3N96YFtA/SSylsKA2p4I/AAAAAAAAAAw/I62t0ZWgncg/s400/tkpong-screenshoot.png]----
[Jeff Smith] 2019-07-18 : Below is an online demo using [CloudTk]
<<inlinehtml>>

<iframe height="410" width="530" src="https://cloudtk-app.tcl-lang.org/cloudtk/VNC?session=new&Tk=TkPong" allowfullscreen></iframe>

<<inlinehtml>>

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

[AMG]: Nicely done!  For a fun challenge, play both sides and try to keep the ball in the court.

By the way, I see you're making sure to put non-lvalues on the left hand side of '''[==]''', which is a handy trick in [C] for avoiding unintentional assignment.  This isn't necessary in [Tcl], since [expr] does not have an '''=''' operator.
----
Héctor Francisco Hernández: Thanks for the advice! I coded it some time ago, so maybe it needs some improvements. Please, feel free to modify and recode what you want.

I'm not sure if the http://en.wikipedia.org/wiki/ISC_license%|%ISC license%|% is necessary to tell you that it is free software. If it isn't, please, feel free to remove it.

----

[uniquename] 2013jul29

In case the image above at 'external site' blogspot.com disappears, here is a 
'locally stored' image at wiki.tcl.tk. An image of this 'labor of love', reproducing
a classic video game from the 1970's-1980's era, as a Tk script, deserves backup.

[hernandez_tkPong_wiki23959_screenshot_524x433.jpg]

(Thanks to 'gnome-screenshot', 'mtpaint', and ImageMagick 'convert' on Linux for,
respectively, capturing the screen to a PNG file, cropping the image, and converting
the resulting PNG file to a JPEG file that is less than one-fifteenth the size of the PNG file.
Thanks to FOSS developers everywhere --- including Linux kernel and Gnu developers.
I used the 'mv' command and the ImageMagick 'identify' command in a shell script to easily
rename the cropped image file to contain the image dimensions in pixels.)

This image shows the tkPong image at full-size as it initially appeared on a
monitor at 1024x768 resolution --- with a window manager from Ubuntu 9.10
('Karmic Koala', 2009 October version).

<<categories>> Games | Application | Category Graphics