#! /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("", [\&MoveShip, Ev('x'), Ev('y'), $ship]); $canvas->Tk::bind("", [\&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 # ------------------------------------------------------------