http://qs321.pair.com?node_id=343196
Category: GUI Programming/Fun Stuff
Author/Contact Info mawe
Description: You like Action-Games?
Forget Doom, Quake, Solitaire and Mahjongg! Here comes CamelTrouble ;-)

As you will see, my perl skills are.. let's not talk about it :-/ I think there are some bugs (one I know occurs when you collect the monks). If you have the time, please give me some advice how to improve the code, I'd love to learn from your comments :-)
Have Fun!

Update:Fixed winning detection as PodMaster suggested
Update:Fixed some typos (thank you Albannach)
Update:Fixed monk-collection-bug with help from Vautrin and hossman

#!/usr/bin/perl -w

use Tk;
use strict;

my (@bad_ones,@good_ones);
my (%ud,%lr);
my ($monk_number,$max_monk_number,$goal,$japh_on,$level,$lives,$wave,$
+diff);
my ($top,$canvas,$canvas_status,$camel,$water,$japh_x,$japh_y,$camel_i
+con,
    $python_icon,$coffee_icon,$monk_icon,$monk2_icon,$tree_icon,$monk_
+stat);
my @speed = qw(2 3 4 5 6 7 8 9 10 10);
my @monk_add_when = qw(20 15 10 5 5 4 4 3 2 1);
my @timer=();

load_icons();
set_defaults();
gui();

#--------------------------------------------------
sub set_defaults {
#-------------------------------------------------- 
    $goal = 0;
    $japh_on = 0;
    $monk_number = 5;
    $max_monk_number = $monk_number;
    $level = 1;
    $lives = 3;
    $wave = 1;
    $diff = 0;
}    

#--------------------------------------------------
sub gui {
#-------------------------------------------------- 
    $top = MainWindow->new(-title=>'CamelTrouble');
    
    # the menu
    my $menubar = $top->Menu;
    my $game_menu = $menubar->cascade(-label=>"~Game");
    my $diff_menu = $menubar->cascade(-label=>"~Difficulty");
    my $help_menu = $menubar->cascade(-label=>"~Help");
    $game_menu->command(-label=>"~Go!",-command=>sub{ create_players()
+ });
    $game_menu->command(-label=>"~End",-command=>sub{ 
        stop(); clear_board(); set_defaults() });
    $game_menu->separator();
    $game_menu->command(-label=>"~Quit",-command=>sub{ exit });
    $diff_menu->radiobutton(-label=>"initiate",-variable=>\$diff,-valu
+e=>"0");    
    $diff_menu->radiobutton(-label=>"novice",-variable=>\$diff,-value=
+>"1");    
    $diff_menu->radiobutton(-label=>"acolyte",-variable=>\$diff,-value
+=>"2");    
    $diff_menu->radiobutton(-label=>"scribe",-variable=>\$diff,-value=
+>"3");    
    $diff_menu->radiobutton(-label=>"monk",-variable=>\$diff,-value=>"
+4");    
    $diff_menu->radiobutton(-label=>"friar",-variable=>\$diff,-value=>
+"5");    
    $diff_menu->radiobutton(-label=>"abbot",-variable=>\$diff,-value=>
+"6");    
    $diff_menu->radiobutton(-label=>"bishop",-variable=>\$diff,-value=
+>"7");    
    $diff_menu->radiobutton(-label=>"pontiff",-variable=>\$diff,-value
+=>"8");    
    $diff_menu->radiobutton(-label=>"saint",-variable=>\$diff,-value=>
+"9");    
    $help_menu->command(-label=>"~Help",-command=>\&help);    
    $help_menu->command(-label=>"~About",-command=>\&about);    
    $top->configure(-menu=>$menubar);
    
    # the desert
    $canvas = $top->Canvas(
        -height => 400,
        -width     => 700,
        -bg        => 'goldenrod3',
        -bd        => 8,
        -relief    => 'sunken',
    )->pack;

    # the status-field
    $canvas_status = $top->Canvas(
        -height    => 50,
        -width    => 700,
        -bg        => 'white',
        -bd        => 4,
        -relief    => 'groove',
    )->pack;
    
    # the oasis
    $canvas->createOval(635,190,690,210,-fill=>'blue');
    $canvas->createImage(670,176,-image=>$top->Pixmap(-data=>$tree_ico
+n));
    
    # the borders
    $canvas->createRectangle(90,0,95,180,-fill=>'goldenrod4');
    $canvas->createRectangle(90,220,95,410,-fill=>'goldenrod4');
    $canvas->createRectangle(610,0,615,180,-fill=>'goldenrod4');
    $canvas->createRectangle(610,220,615,410,-fill=>'goldenrod4');
    
    # status bar
    $canvas_status->createText(30,15,-text=>'Water');
    
    # key-bindings    
    $top->bind('<KeyPress-Up>',sub{$canvas->move($camel,0,-10)});
    $top->bind('<KeyPress-Down>',sub{$canvas->move($camel,0,10)});
    $top->bind('<KeyPress-Left>',sub{$canvas->move($camel,-10,0)});
    $top->bind('<KeyPress-Right>',sub{$canvas->move($camel,10,0)});

    MainLoop;
}

#--------------------------------------------------
sub create_players {
#-------------------------------------------------- 
    # the camel
    $camel = $canvas->createImage(50,200,
        -image=>$top->Pixmap(-data=>$camel_icon),
        -tags=>['camel','player'],
    );
    
    #the monks
    @good_ones = ();
    for (0..$monk_number-1) {
        my $x = int(rand(500)) + 100;
        my $y = int(rand(375)) + 15;
        $good_ones[$_]=$canvas->createImage($x,$y,
            -image=>$top->Pixmap(-data=>$monk_icon),
            -tags=>'player',
        );
    }
    $monk_stat = $canvas_status->createText(435,30,
        -text=>"Monks: $monk_number",
        -tags=>'player',
    );
    $canvas_status->createText(300,30,
        -text=>"Level: $level",
        -tags=>'player',
    );
    
    # the enemies
    @bad_ones = ();
    my @en = ($python_icon,$coffee_icon,"python","coffee");
    for (0..$level*2) {
        my $choice = int(rand(2));
        my $bx = int(rand(450)) + 150;
        $bad_ones[$_] = $canvas->createImage($bx,int(rand(350)),
            -image=>$top->Pixmap(-data=>$en[$choice]),
            -tags=>$en[$choice+2],
        );
    }
    
    # up or down?
    foreach (@bad_ones) { $ud{$_} = int(rand(2)) }
    
    # left or right?
    foreach (@bad_ones) { $lr{$_} = int(rand(2)) }
    
    # the water-line
    $water = $canvas_status->createRectangle(
        0,25,200,35,
        -fill=>'lightblue',
        -tags=>'player',
    );
    
    # the door
    $canvas->createRectangle(
        610,180,615,220,
        -fill=>'goldenrod4',
        -tags=>'door',
    );
    
    # japh
    $japh_x = int(rand(450)) + 150;
    $japh_y = int(rand(385)) + 15;
    if (rand(4)<1) {
        $canvas->createText(
            $japh_x,$japh_y,
            -text=>"Japh",
            -fill=>"white",
            -tags=>['player','japh'],
        );
        $japh_on = 1;
    }
    lives_update();
    stop();
    timer();
}

#--------------------------------------------------
sub timer {
#-------------------------------------------------- 
    $timer[0]=$top->repeat(100,\&go);
    $timer[1]=$top->repeat(2000,\&water_loss);
    $timer[2]=$top->repeat(1000,\&monk_wave);
}

#--------------------------------------------------
sub stop { map { $_->cancel() } @timer }
#-------------------------------------------------- 

#--------------------------------------------------
sub go {
#-------------------------------------------------- 
    my @camel = ($canvas->coords('camel'));
    
    # don't go outside the field
    if ($camel[1]<20) {
        $top->bind('<KeyPress-Up>',sub{$canvas->move($camel,0,10)});
    } elsif ($camel[1]>390) {
        $top->bind('<KeyPress-Down>',sub{$canvas->move($camel,0,-10)})
+;
    } else {
        $top->bind('<KeyPress-Up>',sub{$canvas->move($camel,0,-10)});
        $top->bind('<KeyPress-Down>',sub{$canvas->move($camel,0,10)});
+    
    }
    
    # open door
    if ($monk_number == 0) { $canvas->delete('door') }
    
    # all monks collected
        if (($camel[0]>620) and ($camel[1]>180 and $camel[1]<220) and
        $monk_number == 0 and $goal == 0) {
        $canvas->createText(
            350,200,
            -text=>"YEAH !!",
            -font=>'Arial 50',
            -fill=>'darkblue',
            -tags=>'text',
        );
        my $x=5;
        for (0..$max_monk_number-1) {
            $canvas->createImage(
                635+$x,220,
                -image=>$top->Pixmap(-data=>$monk_icon),
                -tags=>'player',
            );
            $x+=5;
        }
        $goal = 1;
        $level++;
        if ($level % $monk_add_when[$diff] == 0) {
            $max_monk_number++;
        }
        $top->after(2000,\&next_one);
    } 
    if ($goal == 0) { bad_ones_move(@camel) } 
    if ($monk_number > 0) { good_ones_go(@camel) } 
    if ($japh_on == 1) { japh_collect(@camel) }
}

#--------------------------------------------------
sub bad_ones_move {
#-------------------------------------------------- 
    my (@camel) = @_;
    my ($vx,$vy);
    my $dvx = $speed[$diff];
    my $dvy = $speed[$diff];
    for (@bad_ones) {
        my ($cox,$coy) = ($canvas->coords($_))[0,1];
        
        # collision
        if (($camel[0] > $cox-20) and ($camel[0] < $cox+20) and 
             ($camel[1] > $coy-20) and ($camel[1] < $coy+20)) {
            # was it a coffee?
            if ($canvas->gettags($_) eq 'coffee') {
                $canvas_status->move($water,-10,0);        
            # or a python?
            } else {
                $goal = 1;
                $lives--;
                $canvas->createText(
                    350,200,
                    -text=>"D'OH!!!",
                    -font=>'Arial 30',
                    -tags=>'text',
                );
                $top->after(2000,sub{ $canvas->delete('text');\&next_o
+ne() });
            }
        }
        
        # enemies bounce off the walls
        if ($coy<390 and $ud{$_}==1) { $vy=$dvy } else { $vy=-$dvy;$ud
+{$_}=0 }
        if ($coy<20 and $ud{$_}==0) { $vy=$dvy;$ud{$_}=1 }
        if ($cox>110 and $lr{$_}==1) { $vx=-$dvx } else { $vx=$dvx;$lr
+{$_}=0 }
        if ($cox>600 and $lr{$_}==0) { $vx=-$dvx;$lr{$_}=1 }
        $canvas->move($_,$vx,$vy);
    }
}

#--------------------------------------------------
sub good_ones_go {
#--------------------------------------------------
    my @camel = @_;
    for (0..$#good_ones) {
        my ($gox,$goy) = ($canvas->coords($good_ones[$_]))[0,1];

        # collision with monk
        if (defined $good_ones[$_]) {
            if (($camel[0] > $gox-20) and ($camel[0] < $gox+20) and
                ($camel[1] > $goy-20) and ($camel[1] < $goy+20)) {
                $canvas->delete($good_ones[$_]);
                splice @good_ones,$_,1;
                $monk_number--;
                $canvas_status->itemconfigure(
                    $monk_stat,
                    -text=>"Monks: $monk_number",
                );
            }
        }
    }
}

#--------------------------------------------------
sub japh_collect {
#-------------------------------------------------- 
    my @camel = @_;
    if (($camel[0] > $japh_x-20) and ($camel[0] < $japh_x+20) and
        ($camel[1] > $japh_y-20) and ($camel[1] < $japh_y+20)) {
        $canvas->delete('japh');
        $canvas->createText(350,200,
            -text=>"camel++",
            -font=>'Arial 20',
            -fill=>'blue',
            -tags=>'text',
        );
        $lives++;
        lives_update();
        $top->after(2000,sub{$canvas->delete('text')});
        $japh_on = 0;
    }
}
    
#--------------------------------------------------
sub lives_update {
#-------------------------------------------------- 
    $canvas->delete('live');
    $canvas_status->delete('live');
    
    # reserve camels
    my $cx = 170;
    for (1..$lives-1) {
        $canvas->createImage(
            50,$cx,
            -image=>$top->Pixmap(-data=>$camel_icon),
            -tags=>['plaxer','live'],
        );
        $cx=$cx-20;
    }
    $canvas_status->createText(
        575,30,
        -text=>"Lives: $lives",
        -tags=>'live',
    );
}

#--------------------------------------------------
sub monk_wave {
#--------------------------------------------------
    foreach (@good_ones) {
        if ($wave == 1) {
            $canvas->itemconfigure(
                $_,
                -image=>$top->Pixmap(-data=>$monk2_icon),
            );
            $wave = 0;
        } else {
            $canvas->itemconfigure(
                $_,
                -image=>$top->Pixmap(-data=>$monk_icon),
            );
            $wave = 1;
        }
    }
}

#--------------------------------------------------
sub water_loss {
#-------------------------------------------------- 
    if ($goal == 0) {
        if (($canvas_status->coords($water))[0] < -50) {
            $canvas_status->itemconfigure(
                $water,
                -fill=>'yellow',
            )
        }
        if (($canvas_status->coords($water))[0] < -120) {
            $canvas_status->itemconfigure(
                $water,
                -fill=>'red',
            )
        }
        if (($canvas_status->coords($water))[0] == -140) {
            $canvas->createText(
                350,200,
                -text=>"Hurry Up!!!",
                -font=>'Arial 30',
                -fill=>'red',
                -tags=>'text',
            );
            $top->after(1500,sub{ $canvas->delete('text') });
        }
        if (($canvas_status->coords($water))[0] < -180) {
            $goal = 1;
            $lives--;
            $canvas->createText(
                350,200,
                -text=>"Camel died of thirst!!!",
                -font=>'Arial 20',
                -tags=>'text',
            );
            $top->after(2000,sub{ $canvas->delete('text');\&next_one()
+ });
        }
        $canvas_status->move($water,-10,0);
    } 
}

#--------------------------------------------------
sub next_one {
#-------------------------------------------------- 
    $canvas->delete('text');
    if ($lives == 0) {
        $canvas->createText(
            350,200,
            -text=>"Game Over",
            -font=>'Arial 50',
            -tags=>'text',
        );
        $top->after(2000,sub{ stop(); clear_board(); set_defaults() })
+;
    } else {
        $canvas->createText(
            350,200,
            -text=>"Entering level $level",
            -font=>'Arial 20',
            -tags=>'text',
        );
        $top->after(2000,sub{
            clear_board();
            $monk_number = $max_monk_number;
            $goal=0;
            create_players()});
    }
}

#--------------------------------------------------
sub clear_board {
#-------------------------------------------------- 
    $canvas->delete('player','python','coffee','text');
    $canvas_status->delete('player');
}

#--------------------------------------------------
sub about {
#-------------------------------------------------- 
    my $ab = $top->Toplevel(-title=>"About");
    $ab->Label(-text=>"CamelTrouble\nwritten by mawe \n(aka Markus Wei
+hs)",
        )->pack;
}

#--------------------------------------------------
sub help {
#-------------------------------------------------- 
    my $ab = $top->Toplevel(-title=>"About");
    $ab->Label(-text=>"
CamelTrouble\n
Some Perlmonks have been lost in the desert. Help our camel to find th
+em
and bring them to the oasis before you run out of water.
Watch out for the evil enemies: Python and Java.. ehm, coffee!
If you touch a Python, you die. Touch a coffee and you lose water.
The Japhs act like magic spells: collect them and gain  lives!")->pack
+;
}

#--------------------------------------------------
sub load_icons {
#-------------------------------------------------- 
$camel_icon = <<'EOF';
/* XPM */
static char *quit[]={
"30 24 2 1",
"x c brown",
". c None",
".......xxxx...................",
"......xxxxxxx........xxxxxxx..",
".....xxxxxxxxx.....xxxxxxxxxx.",
".....xxxxxxxxx......xxxxxxxx..",
"....xxxxxxxxxxxx....xxxxx.....",
"...xxxxxxxxxxxxxxx..xxxxxx....",
"...xxxxxxxxxxxxxxx..xxxxxx....",
"..xxxxxxxxxxxxxxxxx.xxxxxx....",
"..xxxxxxxxxxxxxxxxx.xxxxxx....",
".xxxxxxxxxxxxxxxxxxxxxxxxx....",
"xxxxxxxxxxxxxxxxxxxxxxxxx.....",
"xxxxxxxxxxxxxxxxxxxxxxxx......",
"x.xxxxxxxxxxxxxxxxxxxxx.......",
"x..xxx.xxxxxxxxxxxxxx.........",
"xx.xxx..xx..xxx..xxx..........",
"xx.xxx..xx..xxx..xxx..........",
"xx.xx...xx...xxx..xx..........",
"...xx...xx...xx...xx..........",
"...x....xx...x....xx..........",
"...x.....x..x......x..........",
"...x......xx.......x..........",
"...x......xx........x........",
"...x.....xx.xx......x........",
"..xxx...............xx......."},
EOF

$python_icon = <<'EOF';
/* XPM */
static char *quit[]={
"30 20 5 1",
"x c darkgreen",
"# c blue",
"+ c green",
"a c red",
". c None",
".......xxx.xxx................",
"......x...x...x...............",
"......x.##x.##x...............",
"......x.##x.##xxxxxxx.........",
"..xxxx+++++++++++++++xx.......",
".x+++++++++++++++++++++x......",
".x++++++++xxx++++++++++x......",
".x++++++xxx++++xx+++++xx......",
"..xxxxxx+++++xx.x+++++x.......",
"...ax+++++xxx...x++++x........",
"...ax+++xxx...xx++++x.........",
"..aaxxxx....xx+++++x..........",
".a.a.......x++++++x...........",
"a..a.....xx+++++xx............",
".......xxx+++++x...xx....x....",
".....xxx++++++++xxx++xxxx.....",
"....x++++++++++++++x++xx......",
"...xx+++++++xx+++xx.xx........",
"....x++++xxx..xxx.............",
".....xxxx....................."},
EOF

$coffee_icon = <<'EOF';
/* XPM */
static char *quit[]={
"30 27 3 1",
"x c blue", 
"+ c red",  
". c None",
"................+.............",
"................++............",
"................++............",
"...............+++............",
"..............+++.............",
".............+++....++........",
"...........+++...+++..........",
".........+++...+++............",
"........+++...+++.............",
".......+++....+++.............",
"........+++...+++.............",
"........+++....+++............",
"..........++....+++...........",
"...........++...+++...........",
".......x.....+..++.....x......",
"......x.........+...x...x.....",
".......xxxxxxxxxxxxx....x.....",
"......................xx......",
".......xx.........x..x........",
"........xxxxxxxxxxx...........",
"..............................",
"...xx....x....................",
"..x......xxxxxxxxx.......xx...",
"...xx..............xxxxxx.....",
".....xxxxxxxxxxxxxx......xx...",
"........x...........xxxxx.....",
".........xxxxxxxxxxx.........."},
EOF

$monk_icon = <<'EOF';
/* XPM */
static char *quit[]={
"30 13 3 1",
"x c yellow", 
"+ c red",  
". c None",
".............xxxx.............",
"............x++++x............",
".............x++x.............",
"..............xx..............",
"..............xx..............",
".......++xxxxxxxxxxx++........",
".......++xxxxxxxxxxx++........",
"..............xx..............",
"..............xx..............",
"..............xx..............",
".............xxxx.............",
"............xx..xx............",
"...........xx....xx...........",
EOF

$monk2_icon = <<'EOF';
/* XPM */
static char *quit[]={
"30 13 3 1",
"x c yellow", 
"+ c red",  
". c None",
".............xxxx.............",
"........++..x++++x..++........",
".........++..x++x..++.........",
"..........xx..xx..xx..........",
"...........xx.xx.xx...........",
"............xxxxxx............",
"............xxxxxx............",
"..............xx..............",
"..............xx..............",
"..............xx..............",
".............xxxx.............",
"............xx..xx............",
"...........xx....xx...........",
EOF

$tree_icon = <<'EOF';
/* XPM */
static char *quit[]={
"30 30 4 1",
"x c brown",
"+ c darkgreen",
"* c green",
". c None",
"...............................",
"..............................",
"..............................",
"..............................",
"..............................",
"..............................",
"......+++++.......+++++.......",
".......++**++...++**++........",
".........+***+.+***+..........",
"....+++++++*******+++++++.....",
"...+******+*******+******+....",
"..+**++++***********++++**+...",
".+*++....++*******++....++*+..",
".++........+*****+........++..",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx.............",
"............xxxxx............."},
EOF
}