#!/usr/bin/perl use lib '/home/awwaiid/projects/perl/Continuity/lib'; use strict; use warnings; use Carp; # XXX $SIG{__DIE__} = sub { confess @_ }; # XXX use Continuity; my $board = Board->new(x=>200,y=>200); my @players; my $server = Continuity->new( port => 20813, #staticp => sub { $_[0]->{request}->url->path =~ m/(jpg|gif|png|css|ico|js)$/; }, ); $server->loop; sub disp { my ($request, $msg) = @_; $msg = qq{ZombieGame
$msg
}; $request->print($msg)->next; } sub main { my ($request, $player, $msg) = (shift)->next; while(!$player) { # Login loop until we find/create a player disp($request,qq{ $msg
Name:
Password:
}); my ($name, $password) = map { s/[^a-zA-Z0-9 -]//g; $_ } # Keep only good chars ($request->param('name'),$request->param('password')); unless($name && $password) { $msg = "Must give name & password" ; next } ($player) = grep $_->name eq $name, @players; if(!$player) { $player = player->new( name => $name, password => $password ); push @players, $player; disp($request, qq{Welcome new player! Start Game}); } elsif($player->password ne $password) { $msg = "Incorrect password!"; undef $player; } } $msg = "Welcome, " . $player->name; while(1) { # Main loop $board->display($request, $player, $msg); my ($action,@ops) = split ',', $request->param('action'); $msg = "BAD ACTION $action" && next unless {move=>1,attack=>1}->{$action}; main->can($action) and $msg = main->can($action)->($request, $player, @ops); } } sub move { # The world is a donut! my ($request, $player, $direction) = @_; $board->desert($player); if($direction eq 'north') { $player->y--; $player->y %= $board->y } elsif($direction eq 'south') { $player->y++; $player->y %= $board->y } elsif($direction eq 'west') { $player->x--; $player->x %= $board->x } elsif($direction eq 'east') { $player->x++; $player->x %= $board->x } $player->last_moved = time; $board->insert($player); return "You move $direction.
\n"; } sub attack { my ($request, $player) = @_; # Pick an enemy from the same location # $enemy = ... # Attack said enemy $player->last_moved = time; #return $player->attack($enemy); } package Board; sub new { my $pack = shift; my $self = bless { x => 100, y => 100, locations => [], @_, }, $pack; #for my $x (0 .. $self->{x}) { $self->{locations}->[$x] = [ map location->new, (0) x $self->y ] } $self; } sub x :lvalue { $_[0]->{x} } sub y :lvalue { $_[0]->{y} } sub locations :lvalue { $_[0]->{locations} } sub insert { my ($self, $ob) = @_; $self->locations->[$ob->x]->[$ob->y]->content = $ob; } # XXX find a near-by empty tile if this one is occupied sub desert { my $self = shift; my $ob = shift; for($self->locations->[$ob->x]->[$ob->y]->content) { $_ = undef if $_ == $ob; } } sub display { my ($self, $request, $player, $msg) = @_; my ($x, $y) = ($player->x - 1, $player->y - 1); my $out = ""; foreach my $b ($y .. $y+2) { my $row = ''; foreach my $a ($x .. $x+2) { $row .= " "; $row .= $self->disp_loc($x % $self->x, $y % $self->y); $row .= ""; } $out .= "$row"; } $out = "$out
"; $request->print($out); return $request->next; } sub disp_loc { my ($self, $x, $y) = @_; return $self->locations->[$x]->[$y]; } # # player related # package player; sub new { my $pack = shift; bless { @_ }, $pack; } sub name :lvalue { $_[0]->{name} } sub password :lvalue { $_[0]->{password} } sub x :lvalue { $_[0]->{x} } sub y :lvalue { $_[0]->{y} } sub inside :lvalue { $_[0]->{inside} } sub got_hit { $_[0]->{hp}--; } # XXX survivor and zombie should subclass player sub attack { } package zombie; use base 'player'; package human; __DATA__ $request->print(qq{
Move
Rot Left Rot Right

}); # Alternative move -- uses coordinates instead of direction sub move { # The world is a donut! my ($request, $player, $new_x, $new_y) = @_; if( $new_x == $player->x && abs($new_y - $player->y) < 2 || $new_y == $player->y && abs($new_x - $player->x) < 2) { $board->desert($player); $player->x = $new_x % $board->x; $player->y = $new_y % $board->y; $board->insert($player); return "You move $direction.
\n"; } else { return "Illegal move to ($new_x, $new_y) } }
upper-left upper-center upper-right
center-left center-center center-right
lower-left lower-center lower-right