#!/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 explain 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 $y1 <= 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 $y1 <= 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',-fg =>'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 => \&newgame)->
                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});
}