#!/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});
}
|