#!/usr/bin/perl
#
# Nibbles Tournament!
# ------ Global Declarations -----------------------------------------
+----------
use Curses;
use Time::HiRes;
use IO::Socket;
use strict;
$| = 1; # set autoflush STDOUT
local $SIG{PIPE} = sub { snake_die("peer disconnected"); };
my $snake_length = 40;
my (@snake, @peer_snake);
# ------ Setup IPC ---------------------------------------------------
+----------
my $socket;
umask(000);
my $SOCKET_NAME = '/tmp/nibbles_socket';
if (-S $SOCKET_NAME) { # if socket found...
# do the client thing
print "Connecting to server...";
$socket = new IO::Socket::UNIX (Type => SOCK_STREAM,
Peer => $SOCKET_NAME) or die $!;
print "connected!\n";
}
else {
# be a server and wait for a client
my $server = new IO::Socket::UNIX(Type => SOCK_STREAM,
Local => $SOCKET_NAME,
Listen => 10 ) or die $!;
print "Waiting for client...";
$socket = $server->accept();
print "connected!\n";
}
print "Hit <enter> to start the game.";
my $xyz = <STDIN>;
# ------ Setup Curses Library ----------------------------------------
+----------
initscr;
cbreak(); # do not wait for EOL
nodelay(1); # non-blocking getch()
noecho();
keypad(1); # interpret esc-keys as one char
print chr(14); # use alternate char set
# ------ Setup Snake -------------------------------------------------
+----------
# init the snake
my $string = chr(113);
for my $i (1..$snake_length) {
$i += 5;
push @snake, { x => 1, y => 1, chr => $string };
}
# start out heading left or down
my ($d_val, $d_axis) = (1, ("x","y")[int(rand 2)]);
# initialize last-direction vars
my $last_d_val = $d_val;
my $last_d_axis = $d_axis;
# ------ Game Loop ---------------------------------------------------
+----------
while(1) {
# clear snake tails
addstr($snake[$#snake]->{y}, $snake[$#snake]->{x}, ' ');
addstr($peer_snake[$#peer_snake]->{y}, $peer_snake[$#peer_snake]->
+{x}, ' ')
if (@peer_snake);
# build scalar representation of our snake for transmission
my $snake_data;
foreach my $se (@snake) { $snake_data .= join ',',
($se->{x}, $se->{y}, $se->{chr},''); }
$snake_data =~ s/,$/\n/;
# send our snake data to our peer
print $socket $snake_data;
# read a line from our peer
my $peer_data = <$socket>;
chomp $peer_data;
# test for special messages from our peer
if ($peer_data =~ /DIED: (.*)/) { snake_die("You Win! Your oppone
+nt has $1"); }
if ($peer_data =~ /TIED/) { snake_die("Tie! Both snakes have hit
+each other!"); }
# build peer snake from recv'd data
my (@peer_elements);
@peer_snake = (); # nuke old peer snake data
@peer_elements = split /,/, $peer_data;
while (@peer_elements) {
my $href;
$href->{x} = shift @peer_elements;
$href->{y} = shift @peer_elements;
$href->{chr} = shift @peer_elements;
push @peer_snake, $href;
}
$last_d_val = $d_val; # remember last val for turning
$last_d_axis = $d_axis;
my $key = getch(); # scan keyboard in non-blocking mode
last if $key eq 'q'; # 'q' to quit!
# handle arrow keys
if ($key == 260 && $d_axis eq 'y') { $d_val = -1; $d_axis = 'x'; }
if ($key == 261 && $d_axis eq 'y') { $d_val = 1; $d_axis = 'x'; }
if ($key == 259 && $d_axis eq 'x') { $d_val = -1; $d_axis = 'y'; }
if ($key == 258 && $d_axis eq 'x') { $d_val = 1; $d_axis = 'y'; }
# take the end of the tail and make it the head
my $tail_piece = pop @snake;
# set tail_piece to the position of the head
$tail_piece->{x} = $snake[0]->{x};
$tail_piece->{y} = $snake[0]->{y};
# trod along our path
$tail_piece->{$d_axis} += $d_val;
# if we are over one of our boundries, jump to the other side
if ($d_axis eq 'x' && $tail_piece->{x} >= getmaxx()) { $tail_piece
+->{x} = 1; }
if ($d_axis eq 'y' && $tail_piece->{y} >= getmaxy()) { $tail_piece
+->{y} = 1; }
if ($d_axis eq 'x' && $tail_piece->{x} < 1) { $tail_piece->{x} = g
+etmaxx(); }
if ($d_axis eq 'y' && $tail_piece->{y} < 1) { $tail_piece->{y} = g
+etmaxy(); }
# determine character to write
if ($d_axis eq 'y' && $last_d_axis eq 'x') {
# change current head piece's string
my $current_head = $snake[0];
if ($d_val > 0) { # we have just turned down
if ($last_d_val > 0) { $string = chr(107); }
if ($last_d_val < 0) { $string = chr(108); }
}
if ($d_val < 0) { # we have just turned up
if ($last_d_val > 0) { $string = chr(106); }
if ($last_d_val < 0) { $string = chr(109); }
}
$current_head->{chr} = $string;
}
if ($d_axis eq 'x' && $last_d_axis eq 'y') {
# change current head piece's string
my $current_head = $snake[0];
if ($d_val > 0) { # we have just turned right
if ($last_d_val > 0) { $string = chr(109); }
if ($last_d_val < 0) { $string = chr(108); }
}
if ($d_val < 0) { # we have just turned left
if ($last_d_val > 0) { $string = chr(106); }
if ($last_d_val < 0) { $string = chr(107); }
}
$current_head->{chr} = $string;
}
# set string to use for new head
$string = ($d_axis eq 'y') ? chr(120) : chr(113);
$tail_piece->{chr} = $string;
# tail becomes new head
@snake = ($tail_piece, @snake);
# test for hitting yourself
foreach my $snake_bit (@snake[1..$#snake]) {
if ( $snake_bit->{x} == $snake[0]->{x} &&
$snake_bit->{y} == $snake[0]->{y}) {
snake_die("You Lose! You have died because you hit your o
+wn dumb self.");
}
}
# test for hitting your peer
foreach my $snake_bit (@peer_snake[1..$#peer_snake]) {
if ( $snake_bit->{x} == $snake[0]->{x} &&
$snake_bit->{y} == $snake[0]->{y}) {
snake_die("You Lose! You have died because you hit your o
+pponent.");
}
}
# test for hitting each other
if ( $peer_snake[0]->{x} == $snake[0]->{x} &&
$peer_snake[0]->{y} == $snake[0]->{y}) {
snake_die("Tie! Both snakes have hit each other!");
}
# redraw snakes
foreach my $snake_bit (@snake, @peer_snake) {
addstr($snake_bit->{y}, $snake_bit->{x}, $snake_bit->{chr});
}
refresh;
Time::HiRes::sleep (.02);
}
end();
# --- Subroutine Definitions -----------------------------------------
+----------
sub snake_die {
my ($reason) = @_;
$reason ||= "you have simply perished.";
# invert reason for telling opponent
my $peer_reason;
if ($reason =~ /self/i) { $peer_reason = 'crashed into himself.';}
if ($reason =~ /opp/i) { $peer_reason = 'crashed into you!'; }
if ($reason =~ /both/i) { print $socket "TIED\n"; }
else { print $socket "DIED: $peer_reason\n"; }
nodelay(0); # back to blocking mode
print chr(15); # back to normal char set
addstr(getmaxy() / 2, (getmaxx() /2) - length($reason) / 2, $reaso
+n);
my $wait = getch();
end();
}
sub end {
endwin;
print chr(15); # use normal char set
unlink $SOCKET_NAME;
exit;
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.