Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/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; }

In reply to Nibbles Tournament! by twerq

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Domain Nodelet?
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this?Last hourOther CB clients
    Other Users?
    Others chanting in the Monastery: (1)
    As of 2024-07-21 10:35 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found

      Notices?
      erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.