#!/usr/bin/perl
=for comment
...
=cut
use lib '/home/awwaiid/projects/perl/Continuity/lib', '/home/knoppix/projects/coro-httpd/cserver/lib';
use strict;
use warnings;
use Carp; # XXX
$SIG{__DIE__} = sub { confess @_ }; # XXX
use List::Util;
use Coro;
use Coro::Event;
use Continuity;
# use Continuity::Adapt::HttpDaemon;
# my @place_names = do { open my $f, '<', '/usr/share/dict/words' or die $!; List::Util::shuffle grep rand 14 > length $_, map {chomp;$_} grep /^[A-Z]/, <$f>; };
my @place_names = do { open my $f, '<', '/usr/share/dict/words' or die $!; List::Util::shuffle map {chomp;$_} grep /^[A-Z]/, <$f>; };
# print map "$_\n", @place_names; exit;
my $board = [ map { [ map { location->new(name=>shift @place_names)} 0..199 ] } 0..199 ];
my %players;
my $server = Continuity->new(port => 16003);
Event::loop; # $server->loop XXX
sub header () { qq{ZombieGame} }
sub footer () { qq{} }
sub button { $_[2] ||=''; qq{\n}; }
sub main {
my $request = shift; $request->next;
my $player;
my $msg = '';
while(! $player) {
$request->print(header, qq{ }, footer, );
$request->next;
my ($name, $password) = grep m/^[A-Za-z0-9][a-zA-Z0-9 -]{1,10}[a-z0-9]$/, map $request->param($_), qw/name password/;
$name and $password or redo;
if(exists $players{$name}) {
$players{$name}->password eq $password or redo;
} else {
$players{$name} = player->new( name => $name, password => $password );
}
$player = $players{$name};
}
$request->print(header, qq{Welcome player! }, footer, );
while(1) { # Main loop
$request->next;
my $action = $request->param('action');
if(time - $player->last_moved < 0) { # XXX
$msg = "Can't move yet...\n";
} elsif($action =~ m/^[a-z]+$/ and actions->can($action)) {
$msg = actions->can($action)->($request, $player);
$player->last_moved = time;
}
my $view = '';
foreach my $yd ($player->y-1 .. $player->y+1) {
my $row = '';
foreach my $xd ($player->x-1 .. $player->x+1) {
my $loc = $board->[$xd % 100]->[$yd % 100];
$row .= "
" . $loc->name . " ";
$row .= join '', map $_->desc, values %{ $player->inside ? $loc->contents_inside : $loc->contents_outside }; # XXX if inside, should only show contents for the current tile
$row .= "
";
}
$view .= "
$row
";
}
# XXX this should probably be combined with the existant map... have to translate $x <=> $player->x and $y <=> $player->y into north/nothing/south/west/northing/east dictates
$request->print(header, qq{
$view
$msg
You are @{[ $player->corpse ? 'laying' : 'standing' ]} @{[ $player->inside ? 'inside' : 'outside' ]} @{[ $player->location->name ]} Building. You are @{[ $player->alive ? 'alive' : 'dead' ]}.
HP: @{[ $player->hp ]} Barricades: @{[ $player->location->hp ]}
});
if($player->corpse) {
$request->print(qq{You're dead!}, button('stand', 'Stand up as a Zombie'), );
} else {
$request->print(button('attack', 'Attack', join '', qq{\n}));
$player->inside and $request->print(button('outside', 'Exit Building'));
! $player->inside and $request->print(button('inside', 'Enter Building'));
$player->alive and $request->print(button('barricade', 'Barricade'));
$player->location->hp and $request->print(button('unbarricade', 'Attack Barricade'));
}
$request->print(footer, );
}
}
package actions;
sub move { # The world is a donut!
my ($request, $player) = @_;
my $direction = $request->param('direction');
$player->corpse and return "You're dead and unable to move.\n";
delete $player->contents->{$player->name};
if($direction =~ m/north/i) { $player->y--; $player->y %= 100 }
if($direction =~ m/south/i) { $player->y++; $player->y %= 100 }
if($direction =~ m/west/i) { $player->x--; $player->x %= 100 }
if($direction =~ m/east/i) { $player->x++; $player->x %= 100 }
$player->inside = 0; # XXX here's where the "free running" skill would go, if we wanted it... in some form...
$player->contents->{$player->name} = $player;
return "You move $direction. $player->{x} $player->{y}\n";
}
sub inside {
my ($request, $player) = @_;
$player->inside and return "What?\n";
$player->alive and $player->location->hp > 20 and return "Too heavily barricaded to enter.\n";
$player->zombie and $player->location->hp > 0 and return "Too heavily barricaded to enter.\n";
delete $player->contents->{$player->name};
$player->inside = 1;
$player->contents->{$player->name} = $player;
return "You enter the building.\n";
}
sub outside {
my ($request, $player) = @_;
$player->inside or return "What?\n";
$player->alive and $player->location->hp > 30 and return "Too heavily barricaded to get out.\n";
$player->zombie and $player->location->hp > 10 and return "Too heavily barricaded to get out.\n";
delete $player->contents->{$player->name};
$player->inside = 0;
$player->contents->{$player->name} = $player;
return "You exit the building.\n";
}
sub barricade {
my ($request, $player) = @_;
$player->zombie and return "Meh?\n";
$player->location->hp++; # XXX success/failure roll that gets harder and harder the higher the barricade
'Okay...';
}
sub unbarricade {
my ($request, $player) = @_;
$player->location->hp > 0 or return "The barricade is already down.\n";
$player->location->hp--; # XXX success/fail roll
'Okay...';
}
sub attack {
my ($request, $player) = @_;
my $target_name = $request->param('target') or return 'No';
# my $target_ob = $board->[$player->x]->[$player->y]->contents->{$target} or return 'No';
my $target_ob = $player->contents->{$target_name} or return 'No';
if($target_ob->corpse) {
return "They're already dead, which makes it easy to beat them some more.\n"; # XXX enough HP damage and the head comes off?
} elsif(int rand 10 >= 5) {
$target_ob->hit_player(1);
return "You attack $target_name and hit -- they slump to the ground.\n" if $target_ob->corpse;
return "You attack $target_name and hit.\n";
} else {
return "You attack $target_name and miss.\n";
}
}
sub stand {
my ($request, $player) = @_;
$player->corpse or return "You're not dead...\n";
$player->hp = 50;
return "You stand up and find yourself craving brains...\n";
}
package player;
sub new { my $pack = shift; bless { hp => 50, last_moved => 1, inside => 0, zombie => 0, x => int rand 100, y => int rand 100, @_ }, $pack; }
sub name { $_[0]->{name} }
sub password { $_[0]->{password} }
sub x :lvalue { $_[0]->{x} }
sub y :lvalue { $_[0]->{y} }
sub hp :lvalue { $_[0]->{hp} }
sub last_moved :lvalue { $_[0]->{last_moved} }
sub inside :lvalue { $_[0]->{inside} }
sub zombie { $_[0]->{zombie} }
sub alive { ! $_[0]->{zombie} }
sub corpse { $_[0]->{hp} < 1 }
sub hit_player {
my $self = shift;
return if $self->hp < 1;
$self->hp--;
$self->hp < 1 and $self->{zombie} = 1;
}
sub desc { my $self = shift; qq{} . $self->name . qq{\n}; }
sub location { my $self = shift; $board->[$self->x]->[$self->y]; }
sub contents { my $self = shift; my $loc = $self->location; $self->inside ? $loc->contents_inside : $loc->contents_outside }
package location;
sub new { my $pack = shift; bless { contents_inside => { }, contents_outside => { }, hp => 0, @_ }, $pack; }
sub name { $_[0]->{name} }
sub contents_inside { $_[0]->{contents_inside} }
sub contents_outside { $_[0]->{contents_outside} }
sub hp :lvalue { $_[0]->{hp} }