#! /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( "",   [ \&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 ] ); }    # 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 # ------------------------------------------------------------