http://qs321.pair.com?node_id=411515
Category: Fun Stuff
Author/Contact Info zentara
Description: My contribution to National Defense. :-) Up and Down Arrows adjust firing power at battery expense. Left and Right keys rotate turret. Spacebar fires.

It would have been easier with Tk::Zinc(which supports rotations); but I kludged a way to rotate with the plain canvas.

If one warhead hits the ground, it's over.

Of course, fully automatic versions are available with a DOD contract. bwa ha ha :-)

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

# by zentara of perlmonks 
# Up and Down Arrows adjust firing power at battery expense.  
# Left and Right keys rotate turret.  
# Spacebar fires. 
# If one warhead hits the ground, it's over.  
# Ammo is limited to 500 
# There are 100 incoming missles possible.  
# Batteries are recharged by Solar Panels. 
# Kludged a way to rotate, Tk::Zinc would be better 
#  to do this. 

my $mw = MainWindow->new(-bg=>'black');
$mw->geometry('+100+100');

my $height = 400;
my $width  = 600;

# first create a canvas widget 
my $canvas = $mw->Canvas(
    -height => $height,
    -width  => $width,
    -bg     => 'black',
)->pack();

my $turret = $canvas->createOval(
    $width / 2 - 50, $height - 50, $width / 2 + 50, $height + 50,
    -fill   => 'steelblue',
    -tags => ['turret']
);

my $px0 = $width/2;
my $py0 = $height;
my $px = $width/2;
my $py = $height-65;
my $px_new = $px;
my $py_new = $py;

my $angle = 1.57; # pi divided by 2, 90 degrees in radians 
my $power = 50;
my $status = '  Ready  ';

my %projectile;
my %missle;
my $launcher;
my @ammo = (1..15);   #reusable object array for projectiles 
my $bat_level = 100;
my $ammo_tot = 500;
my $missles_max = 100;
my @missles = (1..20); #reusable object array for missles, max in play
+ 
my $hits = 0;

my $cannon = $canvas->createLine(
     $px0,$py0,$px,$py,
    -width      => 10,
    -fill       => 'lightblue',
    -tags => ['cannon'],
);

$canvas->lower('cannon', 'turret');

#1 degree in rads is pi divided by 180 = .01745 
$mw->bind('<Left>',sub{ &rotate(.01745) });
$mw->bind('<Right>',sub{ &rotate(-.01745) });
$mw->bind('<Up>',sub{ &power(10) });
$mw->bind('<Down>',sub{ &power(-10) });
$mw->bind('<space>', sub{ &fire}  );

my $frame = $mw->Frame(-background =>'grey45')->pack(-fill=>'x');

$frame->Label(-text =>'Power ',
                         -bg => 'grey45',
                         -fg => 'green',
                         -borderwidth => 0)->pack(-side=>'left');

$frame->Label(-textvariable => \$power,
                         -bg => 'grey45',
                         -fg => 'green',
                         -width => 3,
                         -borderwidth => 0)->pack(-side=>'left');

$frame->Label(-text => '   ',
               -bg => 'grey45',
             -borderwidth => 0)->pack(-side=>'left');

$frame->Label(-textvariable => \$status,
                         -bg => 'grey45',
                         -fg => 'yellow',
                         -width => 15,
                         -borderwidth => 0)->pack(-side=>'left');

$frame->Label(-text => '   ',
               -bg => 'grey45',
             -borderwidth => 0)->pack(-side=>'left');

$frame->Label(-text =>'Battery Level ',
                         -bg => 'grey45',
                         -fg => 'lightblue',
                         -borderwidth => 0)->pack(-side=>'left');

$frame->Label(-textvariable => \$bat_level,
                         -bg => 'grey45',
                         -fg => 'lightblue',
                         -width =>4,
                         -borderwidth => 0)->pack(-side=>'left');

$frame->Label(-text => '   ',
               -bg => 'grey45',
             -borderwidth => 0)->pack(-side=>'left');


$frame->Label(-text =>'Ammo Supply ',
                         -bg => 'grey45',
                         -fg => 'red',
                         -borderwidth => 0)->pack(-side=>'left');

$frame->Label(-textvariable => \$ammo_tot,
                         -bg => 'grey45',
                         -fg => 'red',
                         -width => 3,
                         -borderwidth => 0)->pack(-side=>'left');

$frame->Label(-text => '   ',
               -bg => 'grey45',
             -borderwidth => 0)->pack(-side=>'left');


$frame->Label(-text =>'Hits ',
                         -bg => 'grey45',
                         -fg => 'orange',
                         -borderwidth => 0)->pack(-side=>'left');

$frame->Label(-textvariable => \$hits,
                         -bg => 'grey45',
                         -fg => 'orange',
                         -width => 3,
                         -borderwidth => 0)->pack(-side=>'left');

$frame->Button(
    -text    => 'Exit',
    -command => sub{ exit }
)->pack(-side=>'right',-padx => 3);

my $startbut;
$startbut = $frame->Button(
       -text    => 'New Game',
       -command => sub{
                 $startbut->configure(-state=>'disabled');
                 &launch  },
)->pack(-side=>'right',-padx=>3);


my $solar_panel = Tk::After->new($canvas,1000,'repeat',
        sub {
        $bat_level++;
        $bat_level = sprintf "%.1f", $bat_level;

        if($bat_level > 100){ $bat_level = 100 }
        });

MainLoop();
##################################################################### 
sub launch{

 $mw->bind('<space>', sub{ &fire}  );
 $status = 'Ready';

 $launcher = Tk::After->new($canvas,1000,'repeat',
      sub {
          my $rand = int(rand(100));
          if( $rand > 70 ){ #launch 

              $missles_max--;

              if($missles_max == 0){
                 print chr(07);
                 $status = 'You Win';
                 &restart;
               }

             my $misl = shift @missles;
             my $mx = int(rand $width);
             my $my = -20;

             $missle{$misl}{'warhead'} =
                    $canvas->createOval($mx-8,$my-8,$mx+8,$my+8,
                     -fill => 'yellow');

            my ($dx,$dy);
              $dx =  0;
              $dy = .8;

     $missle{$misl}{'repeater'} = Tk::After->new($canvas,10,'repeat',
        sub {
        $canvas->move($missle{$misl}{'warhead'}, $dx,$dy);
        my ($x,$y,$x1,$y1) = $canvas->bbox($missle{$misl}{'warhead'});
         my @overlap = $canvas->find( 'overlapping', $x,$y,$x1,$y1 );

           if(scalar @overlap > 1){
                $missle{$misl}{'repeater'}->cancel;
                $canvas->delete($missle{$misl}{'warhead'});
                $missle{$misl} = ();
                push @missles, $misl;
                $hits++;
             }

           if($y > $height + 10) {
             $missle{$misl}{'repeater'}->cancel;
             $canvas->delete($missle{$misl}{'warhead'});
             $missle{$misl} = ();
             push @missles, $misl;
             print chr(07);
                 $status = 'Uh Oh Boom';
                 &restart;
           };
      });

            }

        });

}
#################################################################### 
#################################################################### 
sub fire{

if((scalar @ammo == 0)||
    ($ammo_tot < 0)||
     ($bat_level < 0)) {
        print chr(07);
        $status = 'Gun Jambed';
        return
   }

my $num = shift @ammo;

$projectile{$num}{'shell'} =
         $canvas->createOval($px_new-4,$py_new-4,$px_new+4,$py_new+4,
              -fill => 'pink');

$bat_level -= 1.5;
$bat_level = sprintf "%.1f",$bat_level;
$ammo_tot--;

my ($dx,$dy);
if($px_new == $px0){ $dy = -$power/10 ; $dx = 0}
   else{  $dx = cos($angle) * $power/10;
          $dy = -sin($angle)* $power/10;
 }

$projectile{$num}{'repeater'} = Tk::After->new($canvas,10,'repeat',
        sub {$canvas->move($projectile{$num}{'shell'}, $dx,$dy);
              my ($x,$y) = $canvas->bbox($projectile{$num}{'shell'});

           if($y > $height + 10 || $y < -10 || $x < -10 || $x > $width
+ +10) {
             $projectile{$num}{'repeater'}->cancel;
             $canvas->delete($projectile{$num}{'shell'});
             $projectile{$num} = ();
             push @ammo, $num;
             $status = 'Ready';
           };
      });
}

######################################################################
+### 
sub power{
my $pow = shift;
$power += $pow;
if($power < 10){$power = 10}
if($power > 100){$power = 100}
}
######################################################################
+#### 
sub rotate{
 my $change = shift;

  $angle += 5*$change;

 if( $angle > 3.1 ){$angle = 3.1;return}
 if( $angle < .1 ){$angle = .1;return}
 $angle = sprintf "%.4f",$angle;
#  print "$angle\t"; 

$py_new = $height - sin($angle)*65;
$px_new = ($width/2) + ( cos($angle)*65);

$canvas->delete($cannon);
$cannon = ();
$cannon = $canvas->createLine(
     $px0,$py0,$px_new,$py_new,
    -width      => 10,
    -fill       => 'lightblue',
    -tags => ['cannon'],
);

$canvas->lower('cannon', 'turret');
}
######################################################################
+##### 
sub restart{

$launcher->cancel;
$mw->bind('<space>', sub{ }  );

my $wait;
$wait = Tk::After->new($canvas,10,'repeat',
        sub {
          if(scalar @missles == 20){
            $wait->cancel;
            $bat_level = 100;
            $ammo_tot = 500;
            $missles_max = 100;
            $hits = 0;
            $startbut->configure(-state =>'normal');
          }else{return}
    });

}
######################################################################
+###