Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

PONG with TkZinc

by zentara (Archbishop)
on Nov 15, 2003 at 17:14 UTC ( #307332=sourcecode: print w/replies, xml ) Need Help??
Category: Fun Stuff
Author/Contact Info zentara@zentara.net
Description: This is a PONG game made with the TkZinc module. TkZinc is a "canvas" with excellent 2d translations and rotation, and includes "groups". A PONG screenshot. Also, I have been documenting my "learning process with TkZinc, and have it in a beginner's tutorial at TkZinc Beginners Tutorial.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Zinc;

my $motion_flag = 0;
my $count = 0;
my $delay = 50; #adjust for speed of your computer 
my $speed = 1000 - $delay;
my $width = 700;
my $height = 600;
my ($leftscore,$rightscore)=(0,0);
my ($up,$left)=(0,0);
my $serve = 'left';
my $randx;
my $randy;
my $dx;
my $dy;
my $lauto = 0;
my $rauto = 0;
my @hits = (-1,1);

my $mw = MainWindow->new;
$mw->geometry($width.'x'.$height);
$mw->resizable(0,0);

my $zinc = $mw->Zinc(-width => $width, -height => $height - 35,
                -backcolor => 'black',
                -borderwidth => 3,
                -relief => 'sunken',
                )->pack;

# Then we create a gray filled rectangle, in which we will display exp
+lain text. 
my $message = $zinc->add('rectangle', 1 , [200, 400, 490, 490],
              -linewidth => 2,
              -visible => 0,
              -filled => 1,
              -fillcolor => 'SkyBlue',
                               );
my $text = $zinc->add('text', 1,
                      -position => [350, 445],
                      -visible => 0,
                      -anchor => 'center',
                      -priority => 2
                      );


my $leftgroup= $zinc->add('group',1,-visible=> 1);
$zinc->translate($leftgroup,0,281);

my $rightgroup= $zinc->add('group',1,-visible=> 1);
$zinc->translate($rightgroup,700,281);


#pong paddles 
my $leftpaddle = $zinc->add('rectangle',$leftgroup ,[0,-20, 20,20],
                            -linewidth => 2,
                            -filled => 1,
                            -fillcolor => 'red',
                            );

my $rightpaddle = $zinc->add('rectangle',$rightgroup, [0,-20,-20,20],
                               -linewidth => 2,
                               -filled => 1,
                               -fillcolor => 'red',
                            );


#my $pongx 
#a circle is bounded by a square box, specify 2 diagonal points  
my $pong = $zinc->add('arc',1, [30, -20, 50, 0], -fillcolor => "yellow
+", -filled => 1);


######################################################################
+######## 
# Display comment 
&comment("Hit Enter to begin. 
$serve is serving 
Up arrow inreases speed  
Down arrow decreases speed  
Escape to pause ");

#set key binding 
$mw->Tk::bind('<Return>', \&start);
$mw->Tk::bind('<a>', sub{ my($x1,$y1) =  $zinc->coords($leftgroup);
                          $zinc->translate($leftgroup,0,-40) unless $y
+1 <= 40 });

$mw->Tk::bind('<z>', sub {my($x1,$y1) =  $zinc->coords($leftgroup);
                         $zinc->translate($leftgroup,0,40) unless $y1 
+>= 535 });

$mw->Tk::bind('<k>', sub{my($x1,$y1) =  $zinc->coords($rightgroup);
                         $zinc->translate($rightgroup,0,-40) unless $y
+1 <= 40 });

$mw->Tk::bind('<m>', sub{my($x1,$y1) =  $zinc->coords($rightgroup);
                         $zinc->translate($rightgroup,0,40) unless $y1
+ >= 535 });

$mw->Tk::bind('<Up>', sub{$delay = ($delay -1) unless $delay <= 1;
                                       $speed = 1000 - $delay;
                                       $mw->update });

$mw->Tk::bind('<Down>', sub{$delay = ($delay + 1)unless $delay >= 1000
+;
                                       $speed = 1000 - $delay;
                                       $mw->update});


my $f1 = $mw->Frame->pack(-side => 'left', -fill => 'both', -expand =>
+ 1,);

   my $lscore = $f1->Label(-textvariable => \$leftscore, -bg => 'black
+', -fg =>'red')->
              pack( -side => 'left', -fill => 'both', -expand => '1',)
+;

   $f1->Label(-text => "<-- a-up\nz-down", -bg => 'green',)->
              pack( -side => 'left', -fill => 'both', -expand => '1',)
+;

my $f2 = $f1->Frame->pack(-side => 'left', -fill => 'both', -expand =>
+ 1,);
  $f2->Label(-text => "Left AutoPlay", -bg => 'grey')->pack;
  my $checkl = $f2->Checkbutton(offvalue => 0,
                 onvalue => 1,
                 state => 'normal',
                 variable => \$lauto)->pack;

$f1->Label(-text => "", -bg => 'black',)->
              pack( -side => 'left', -fill => 'both', -expand => '1',)
+;

my $closebutton = $f1->Button(text => 'Exit', -command => sub{Tk::exit
+(0)})->
                pack( -side => 'left', -fill => 'both', -expand => '0'
+);

my $f3 = $f1->Frame->pack(-side => 'left', -fill => 'both', -expand =>
+ 1,);
   $f3->Label(-text => "Speed", -bg => 'black',-fg =>'green')->
         pack( -side => 'left', -fill => 'both', -expand => '1',);
   my $smeter = $f3->Label(-textvariable => \$speed, -bg => 'black',-f
+g =>'green')->
         pack( -side => 'left', -fill => 'both', -expand => '1',);


$f1->Label(-text => "", -bg => 'black',)->
              pack( -side => 'left', -fill => 'both', -expand => '1',)
+;

my $newgamebutton = $f1->Button(text => "New\nGame", -command => \&new
+game)->
                pack( -side => 'left', -fill => 'both', -expand => '0'
+);

$f1->Label(-text => "", -bg => 'black',)->
              pack( -side => 'left', -fill => 'both', -expand => '1',)
+;


my $f4 = $f1->Frame->pack(-side => 'left', -fill => 'both', -expand =>
+ 1,);
   $f4->Label(-text => 'Right Autoplay', -bg => 'grey')->pack;
   my $checkr = $f4->Checkbutton(offvalue => 0,
                   onvalue => 1,
                   state => 'normal',
                   variable => \$rauto)->pack;

$f1->Label(-text => "k-up-->\nm-down", -bg => 'green')->
    pack( -side => 'left', -fill => 'both', -expand => '1',);

my $rscore = $f1->Label(-textvariable => \$rightscore, -bg => 'black',
+-fg =>'red')->
   pack( -side => 'left', -fill => 'both', -expand => '1',);

MainLoop;

sub start {
    $zinc->itemconfigure($message,-visible => 0);
    $zinc->itemconfigure($text,-visible => 0);
    $checkl->configure(state =>'disable');
    $checkr->configure(state =>'disable');

if($lauto == 1){$mw->Tk::bind('<a>', sub{});
                $mw->Tk::bind('<z>', sub{});
               }
if($rauto == 1){$mw->Tk::bind('<k>', sub{});
                $mw->Tk::bind('<m>', sub{});
               }
               
    $randx = 10 + int rand(5);
    $randy = 5 + int rand(2);
    $dx = $randx;
    $dy = $randy;

    $count =0;
    $motion_flag = 1;
    $mw->Tk::bind('<Return>', sub{});

    &startaction;
}

sub stopaction{
    $motion_flag = 0;
    $mw->Tk::bind('<Return>', \&start);
}

sub startaction {
    $mw->Tk::bind('<Escape>', \&stopaction);

push (@hits,shift(@hits)); #circular list to modify ball movement 

 $dx = $randx;
 $dy = $randy;
#print "$dx  $dy\n"; # for debugging 

if($serve eq 'left'){$zinc->translate($pong,int rand (100),0);$serve =
+ '';}
if($serve eq 'right'){$dx = -$dx;
       $zinc->translate($pong,600 - int rand (100),0);$serve = '';}


my($x1,$y1,$xc1,$yc1) =  $zinc->bbox($pong);
#print "pong-> $x1  $y1  $xc1  $yc1\n"; #for debugging 

my($xl,$yl)= $zinc->coords($leftgroup);
#print "leftpaddle ->$yl\n"; #for debugging 

my($xr,$yr)= $zinc->coords($rightgroup);
#print "rightpaddle ->$yr\n"; #for debugging 

my $mid = $y1/2 + $yc1/2; #midpoint of pong ball 


if($up){$dy = -$dy};
if($left){$dx = -$dx}
$zinc->translate($pong,$dx,$dy);

if($rauto == 1){$zinc->translate($rightgroup,0,$mid - $yr)}
if($lauto == 1){$zinc->translate($leftgroup,0,$mid - $yl)}

if($y1 <= 0){$up = 0} #top bounce 
if($y1 >= 535){$up = 1}; #bottom bounce 

#if($x1 >= 680){$left = 1} #right bounce 
if(($xc1 >= 680)and((($mid)<($yr+20))and(($mid)>($yr-20))))
                        {$left = 1;
                        $randx = $randx + 2*$hits[0]/$randx;
                        $randy = $randy + 2*$hits[0]/$randy;
                         }
                         
    elsif($xc1 >=700){&win('left')}

#if($x1 <= 0){$left = 0} #left bounce 
if(($x1 <= 20)and((($mid)<($yl+20))and(($mid)>($yl-20))))
                           {$left = 0;
                           $randx =  $randx + 2*$hits[0]/$randx;
                           $randy =  $randy + 2*$hits[0]/$randy;
                           }
   elsif($x1<=0){&win('right')}


  if($motion_flag == 1){ $zinc->after($delay, sub {startaction()})}
     else {return}
}
sub resetpos{
$zinc->treset($pong);
 }


# Just display comment  
sub comment {
    $zinc->itemconfigure($message,-visible => 1);
    $zinc->itemconfigure($text,-visible => 1);
    my $string = shift;
    $zinc->itemconfigure($text, -text => $string);
}

# display win  
sub win {
    my $string = shift;
    if($string eq 'left'){$leftscore++;$serve = 'left';$left = 0}
    if($string eq 'right'){$rightscore++;$serve = 'right';$left = 1}
    $mw->update;
    print ("\007");

&comment("Hit Enter to begin. 
$serve is serving 
Up arrow inreases speed  
Down arrow decreases speed  
Escape to pause ");

    $motion_flag=0;
    $zinc->treset($pong);
    $mw->Tk::bind('<Return>', sub{$motion_flag = 1;&start});
}


sub newgame{
$motion_flag = 0;
$count = 0;
($leftscore,$rightscore)=(0,0);
($up,$left)=(0,0);
$serve = 'left';
my $lauto = 0;
my $rauto = 0;

&comment("Hit Enter to begin. 
$serve is serving 
Up arrow inreases speed  
Down arrow decreases speed  
Escape to pause ");

$checkl->configure(state =>'normal');
$checkr->configure(state =>'normal');

    $motion_flag=0;
    $zinc->treset($pong);

    $mw->update;
    $mw->Tk::bind('<Return>', sub{$motion_flag = 1;&start});
}
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://307332]
help
Chatterbox?
and the pool shimmers...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (7)
As of 2017-02-25 14:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Before electricity was invented, what was the Electric Eel called?






    Results (365 votes). Check out past polls.