http://www.perlmonks.org?node_id=207813
Category: Fun Stuff
Author/Contact Info Derek Watson (watson@cksolutions.com)
Description: You've played it on your Nokia handset, you've played it in QBasic 4.5, you've seen Tron. Now experience it in full ASCII glory! Head-to-head action via UNIX Domain sockets was the inspiration behind Nibbles Tournament!
#!/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;
}