#! /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
} # 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 ]);
# print "BOOOMMMM $bullet at ($x1)\n";
} # 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);
} # 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
# ------------------------------------------------------------