#! /usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Dialog ();
my ( $x, $y ) = ( 320, 460 ); # start ship at that position
my @bulletRecycler = ();
my %monsters = ();
my @monsterRecycler = ();
my $monsterCount = 0;
my $mw = MainWindow->new();
$mw->protocol( 'WM_DELETE_WINDOW', \&ExitApplication );
my $canvas = $mw->Canvas(
-background => '#000000',
-height => 480,
-width => 640,
-cursor => 'crosshair'
)->pack( -side => 'top', -fill => 'both', -expand => 1 );
my $ship = &GetNewShip($canvas);
for ( my $i = 100; $i < 600; $i += 30 ) {
for ( my $j = 40; $j < 170; $j += 30 ) {
&GetNewMonster( $canvas, $i, $j );
}
} # for
$canvas->Tk::bind( "<Motion>", [ \&MoveShip, Ev('x'), Ev('y'), $ship ] );
$canvas->Tk::bind( "<Button-1>", [ \&Fire, Ev('x'), Ev('y'), $ship ] );
&Tk::MainLoop;
# ------------------------------------------------------------
sub ExitApplication {
my $dialog = $mw->Dialog(
-text => 'Programm wirklich beenden?',
-bitmap => 'question',
-title => 'Programm beenden',
-default_button => 'Yes',
-buttons => [qw/Ja Nein/],
);
my $answer = $dialog->Show(); # and display dialog
if ( lc($answer) eq 'ja' ) { exit; }
} # ExitApplication
# ------------------------------------------------------------
sub GetNewShip {
my $canvas = shift;
my $ship = $canvas->createPolygon(
$x - 10, $y, $x - 10, $y - 10,
$x - 2, $y - 14, $x, $y - 10,
$x + 2, $y - 14, $x, $y - 15,
$x + 10, $y - 10, $x + 10, $y,
-outline => '#ffffff',
-fill => '#ff0000'
);
return $ship;
} # GetNewShip
# ------------------------------------------------------------
sub GetBullet {
my ( $canv, $x, $y ) = @_;
my $bullet;
if ( scalar @bulletRecycler ) {
$bullet = shift(@bulletRecycler);
$canvas->coords( $bullet, $x - 2, $y - 18, $x + 2, $y - 28 );
} # if
else { # if not possible, create new bullet
$bullet =
$canv->createRectangle( $x - 2, $y - 18, $x + 2, $y - 28,
-fill => 'white' );
} # else
return $bullet;
} # GetBullet
# ------------------------------------------------------------
sub GetNewMonster {
my ( $canvas, $x, $y ) = @_;
my $monster = $canvas->createOval(
$x - 10, $y - 10, $x + 10, $y + 20,
-fill => '#ffff00',
-outline => '#ffffff'
);
$monsters{$monster} = 1;
$monsterCount++;
$canvas->after( 50, [ \&MoveMonster, $canvas, $monster, $x, $y, 10 ] );
return $monster;
} # GetNewMonster
# ------------------------------------------------------------
sub MoveShip {
my ( $canv, $x1, $y1, $ship ) = @_;
$x1 = $canv->canvasx($x1);
# move ship to left or to right
$canv->move( $ship, $x1 - $x, 0 );
$x = $x1;
} # MoveShip
# ------------------------------------------------------------
sub Fire {
my ( $canv, $x1, $y1, $ship ) = @_;
$x1 = $canv->canvasx($x1);
# start firing bullet
my $bullet = &GetBullet( $canvas, $x, $y );
$canv->after( 10, [ \&FireUp, $bullet, $x1, $y - 18 ] );
} # Fire
# ------------------------------------------------------------
sub FireUp {
my ( $tag, $x2, $y2 ) = @_;
$canvas->move( $tag, 0, -8 );
my @items = $canvas->find( "overlapping", $x2 - 2, $y2, $x2 + 2, $y2 - 10 );
local $" = "|";
print "Found: @items\n" if scalar @items > 1;
foreach (@items) {
if ( exists $monsters{$_} ) {
# print "Hit Monster $_\n";
$monsterCount--;
# add monster to recycler
push( @monsterRecycler, $_ );
$canvas->coords( $_, 1, 1001, 21, 1021 ); # very dirty
} # if
} # foreach
if ( $monsterCount <= 0 ) {
&RestartDialog();
} # if
if ( $y2 < 10 ) { # if bullet out of screen
# move bullet to recycler
push( @bulletRecycler, $tag );
$canvas->coords( $tag, 1, 1, 5, 11 ); # dirty, I know
} # if
else { # continue moving bullet up
$canvas->after( 10, [ \&FireUp, $tag, $x2, $y2 - 8 ] );
} # else
} # FireUp
# ------------------------------------------------------------
sub MoveMonster {
my ( $canvas, $monster, $x, $y, $direction ) = @_;
my $down = 0;
if ( $direction < 0 and $x < 20 ) {
$direction = -$direction;
$down = 10;
$y += 10;
} # if
elsif ( $direction > 0 and $x > 620 ) {
$direction = -$direction;
$down = 10;
$y += 10;
} # elsif
else {
$x += $direction;
} # else
$canvas->move( $monster, $direction, $down );
$canvas->after( 50,
[ \&MoveMonster, $canvas, $monster, $x, $y, $direction ] );
} # MoveMonster
# ------------------------------------------------------------
sub RestartDialog {
my $dialog = $mw->Dialog(
-text => "Gewonnen\nNoch mal?",
-bitmap => 'question',
-title => 'Programm beenden',
-default_button => 'Yes',
-buttons => [qw/Ja Nein/],
);
my $answer = $dialog->Show(); # and display dialog
if ( lc($answer) eq 'ja' ) {
exec($0); # dirty, i know
} # if
else {
exit;
} # else
} # RestartDialog
# ------------------------------------------------------------