sourcecode
mawe
<code>
#!/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_icon,
$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,-value=>"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_icon));
# 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_one() });
}
}
# 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 Weihs)",
)->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 them
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
}
</code>
You like Action-Games?<br>
Forget Doom, Quake, Solitaire and Mahjongg! Here comes CamelTrouble ;-)
<p>
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 :-)<br>
Have Fun!
<p>
<b>Update:</b>Fixed winning detection as [id://107642] suggested<br>
<b>Update:</b>Fixed some typos (thank you [id://33341])<br>
<b>Update:</b>Fixed monk-collection-bug with help from [id://323063] and [id://123291]
GUI Programming/Fun Stuff
[id://323251]