mirror of
https://github.com/pragma-/pbot.git
synced 2024-12-25 12:12:34 +01:00
1379 lines
47 KiB
Perl
1379 lines
47 KiB
Perl
# File: Battleship.pm
|
|
#
|
|
# Purpose: Simplified version of the Battleship board game.
|
|
#
|
|
# Note: This code was written circa 1993 for a DikuMUD fork. It was originally
|
|
# written in C, as I was teaching the language to myself in my early teens. Two
|
|
# decades or so later, I transliterated this code from C to Perl for PBot. Much
|
|
# of the "ugly" C-style design of this code has been preserved for personal
|
|
# historical reasons -- I was inspired by the IOCCC and I attempted to be clever
|
|
# with nested conditional operators and other silliness. Please be gentle if you
|
|
# read this code. :)
|
|
|
|
# This Source Code Form is subject to the terms of the Mozilla Public
|
|
# License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
|
|
package Plugins::Battleship;
|
|
use parent 'Plugins::Plugin';
|
|
|
|
use PBot::Imports;
|
|
|
|
use Time::Duration;
|
|
use Data::Dumper;
|
|
|
|
sub initialize {
|
|
my ($self, %conf) = @_;
|
|
|
|
# register `battleship` bot command
|
|
$self->{pbot}->{commands}->register(sub { $self->cmd_battleship(@_) }, 'battleship', 0);
|
|
|
|
# set the channel where to send game messages
|
|
$self->{channel} = $self->{pbot}->{registry}->get_value('battleship', 'channel') // '##battleship';
|
|
|
|
# set debugging flag
|
|
$self->{debug} = $self->{pbot}->{registry}->get_value('battleship', 'debug') // 0;
|
|
|
|
# set board tile symbols/characters
|
|
$self->{player_one_vert} = '|';
|
|
$self->{player_one_horiz} = '—';
|
|
$self->{player_two_vert} = 'I';
|
|
$self->{player_two_horiz} = '=';
|
|
$self->{ocean} = '~';
|
|
$self->{player_one_miss} = '*';
|
|
$self->{player_one_hit} = '1';
|
|
$self->{player_two_miss} = 'o';
|
|
$self->{player_two_hit} = '2';
|
|
|
|
# create game state machine
|
|
$self->create_states;
|
|
}
|
|
|
|
sub unload {
|
|
my ($self) = @_;
|
|
|
|
# unregister `battleship` bot command
|
|
$self->{pbot}->{commands}->unregister('battleship');
|
|
|
|
# remove battleship loop event from event queue
|
|
$self->{pbot}->{event_queue}->dequeue_event('battleship loop');
|
|
}
|
|
|
|
# `battleship` bot command
|
|
sub cmd_battleship {
|
|
my ($self, $context) = @_;
|
|
|
|
my $usage = "Usage: battleship challenge|accept|decline|bomb|board|score|forfeit|quit|players|kick|abort; for more information about a command: battleship help <command>";
|
|
|
|
# strip leading and trailing whitespace
|
|
$context->{arguments} =~ s/^\s+|\s+$//g;
|
|
|
|
my ($command, $arguments) = split / /, $context->{arguments}, 2;
|
|
|
|
$command //= '';
|
|
$command = lc $command;
|
|
|
|
# shorter aliases
|
|
my ($nick, $user, $host, $hostmask, $channel) = (
|
|
$context->{nick},
|
|
$context->{user},
|
|
$context->{host},
|
|
$context->{hostmask},
|
|
$self->{channel},
|
|
);
|
|
|
|
given ($command) {
|
|
# help doesn't do much yet
|
|
when ('help') {
|
|
given ($arguments) {
|
|
when ('help') {
|
|
return "Seriously?";
|
|
}
|
|
|
|
default {
|
|
if (length $arguments) {
|
|
return "Battleship help is coming soon.";
|
|
} else {
|
|
return "Usage: battleship help <command>";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# issue a challenge to begin a game
|
|
when ('challenge') {
|
|
if ($self->{current_state} ne 'nogame') {
|
|
return "There is already a game of Battleship underway.";
|
|
}
|
|
|
|
# `challenge` without arguments issues an open challenge
|
|
if (not length $arguments) {
|
|
$self->set_state('accept');
|
|
|
|
# add player 1, the challenger, to the game
|
|
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
|
|
|
|
my $player = {
|
|
id => $id,
|
|
name => $nick,
|
|
missedinputs => 0
|
|
};
|
|
|
|
push @{$self->{state_data}->{players}}, $player;
|
|
|
|
# add player 2, a placeholder for the challengee
|
|
$player = {
|
|
id => -1,
|
|
name => 'anybody',
|
|
missedinputs => 0
|
|
};
|
|
|
|
push @{$self->{state_data}->{players}}, $player;
|
|
|
|
# start the battleship game loop
|
|
$self->{pbot}->{event_queue}->enqueue_event(sub {
|
|
$self->run_one_state;
|
|
}, 1, 'battleship loop', 1
|
|
);
|
|
|
|
return "/msg $channel $nick has made an open challenge! Use `accept` to accept their challenge.";
|
|
}
|
|
|
|
# otherwise we're challenging a specific person
|
|
|
|
# are they in the channel?
|
|
my $challengee = $self->{pbot}->{nicklist}->is_present($channel, $arguments);
|
|
|
|
if (not $challengee) {
|
|
return "$arguments is not present in $channel. Invite them to the channel and try again!";
|
|
}
|
|
|
|
# set up next state of game
|
|
$self->set_state('accept');
|
|
|
|
# add player 1, the challenger, to the game
|
|
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
|
|
|
|
my $player = {
|
|
id => $id,
|
|
name => $nick,
|
|
missedinputs => 0,
|
|
};
|
|
|
|
push @{$self->{state_data}->{players}}, $player;
|
|
|
|
# add player 2, the challengee, to the game
|
|
($id) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($challengee);
|
|
|
|
$player = {
|
|
id => $id,
|
|
name => $challengee,
|
|
missedinputs => 0,
|
|
};
|
|
|
|
push @{$self->{state_data}->{players}}, $player;
|
|
|
|
# start the battleship game loop
|
|
$self->{pbot}->{event_queue}->enqueue_event(sub {
|
|
$self->run_one_state;
|
|
}, 1, 'battleship loop', 1
|
|
);
|
|
|
|
return "/msg $channel $nick has challenged $challengee to Battleship! Use `accept` to accept their challenge.";
|
|
}
|
|
|
|
# accept challenges
|
|
when ('accept') {
|
|
if ($self->{current_state} ne 'accept') {
|
|
return "/msg $nick This is not the time to use `accept`.";
|
|
}
|
|
|
|
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
|
|
my $player = $self->{state_data}->{players}->[1];
|
|
|
|
# accept an open challenge
|
|
if ($player->{id} == -1) {
|
|
$player->{id} = $id;
|
|
$player->{name} = $nick;
|
|
}
|
|
|
|
# confirm right user is accepting challenge
|
|
if ($player->{id} == $id) {
|
|
# accept the challenge
|
|
$player->{accepted} = 1;
|
|
return "/msg $channel $nick has accepted $self->{state_data}->{players}->[0]->{name}'s challenge!";
|
|
} else {
|
|
# wrong user tried to accept
|
|
return "/msg $nick You have not been challenged to a game of Battleship.";
|
|
}
|
|
}
|
|
|
|
# decline a challenge or forfeit/concede a game
|
|
when (['decline', 'quit', 'forfeit', 'concede']) {
|
|
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
|
|
|
|
my $removed = 0;
|
|
|
|
for (my $i = 0; $i < @{$self->{state_data}->{players}}; $i++) {
|
|
if ($self->{state_data}->{players}->[$i]->{id} == $id) {
|
|
$self->{state_data}->{players}->[$i]->{removed} = 1;
|
|
$removed = 1;
|
|
}
|
|
}
|
|
|
|
if ($removed) {
|
|
if ($self->{current_state} eq 'accept') {
|
|
$self->set_state('nogame');
|
|
$self->{state_data}->{players} = [];
|
|
return "/msg $channel $nick declined the challenge.";
|
|
}
|
|
else {
|
|
return "/msg $channel $nick has left the game!";
|
|
}
|
|
}
|
|
else {
|
|
return "$nick: But you are not even playing the game.";
|
|
}
|
|
}
|
|
|
|
when ('abort') {
|
|
if (not $self->{pbot}->{users}->loggedin_admin($channel, $hostmask)) {
|
|
return "$nick: Only admins may abort the game.";
|
|
}
|
|
|
|
$self->set_state('gameover');
|
|
|
|
return "/msg $channel $nick: The game has been aborted.";
|
|
}
|
|
|
|
when ('score') {
|
|
if (@{$self->{state_data}->{players}} == 2) {
|
|
$self->show_scoreboard;
|
|
return '';
|
|
} else {
|
|
return "There is no game going on right now.";
|
|
}
|
|
}
|
|
|
|
when ('players') {
|
|
if ($self->{current_state} eq 'accept') {
|
|
return "$self->{state_data}->{players}->[0]->{name} has challenged $self->{state_data}->{players}->[1]->{name}!";
|
|
}
|
|
elsif (@{$self->{state_data}->{players}} == 2) {
|
|
return "$self->{state_data}->{players}->[0]->{name} is in battle with $self->{state_data}->{players}->[1]->{name}!";
|
|
}
|
|
else {
|
|
return "There are no players playing right now. Start a game with `challenge <nick>`!";
|
|
}
|
|
}
|
|
|
|
when ('kick') {
|
|
if (not $self->{pbot}->{users}->loggedin_admin($channel, $hostmask)) {
|
|
return "$nick: Only admins may kick people from the game.";
|
|
}
|
|
|
|
if (not length $arguments) {
|
|
return "Usage: battleship kick <nick>";
|
|
}
|
|
|
|
my $removed = 0;
|
|
|
|
for (my $i = 0; $i < @{$self->{state_data}->{players}}; $i++) {
|
|
if (lc $self->{state_data}->{players}->[$i]->{name} eq $arguments) {
|
|
$self->{state_data}->{players}->[$i]->{removed} = 1;
|
|
$removed = 1;
|
|
}
|
|
}
|
|
|
|
if ($removed) {
|
|
return "/msg $channel $nick: $arguments has been kicked from the game.";
|
|
} else {
|
|
return "$nick: $arguments isn't even in the game.";
|
|
}
|
|
}
|
|
|
|
when ('bomb') {
|
|
if ($self->{current_state} ne 'playermove' and $self->{current_state} ne 'checkplayer') {
|
|
return "$nick: It's not time to do that now.";
|
|
}
|
|
|
|
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
|
|
|
|
my $player;
|
|
|
|
if ($self->{state_data}->{players}->[0]->{id} == $id) {
|
|
$player = 0;
|
|
}
|
|
elsif ($self->{state_data}->{players}->[1]->{id} == $id) {
|
|
$player = 1;
|
|
}
|
|
else {
|
|
return "You are not playing in this game.";
|
|
}
|
|
|
|
# no arguments provided
|
|
if (not length $arguments) {
|
|
if (delete $self->{state_data}->{players}->[$player]->{location}) {
|
|
return "$nick: Attack location cleared.";
|
|
} else {
|
|
return "$nick: Usage: bomb <location>";
|
|
}
|
|
}
|
|
|
|
# validate arguments
|
|
$arguments = uc $arguments;
|
|
|
|
if ($arguments !~ m/^[A-Z][0-9]+$/) {
|
|
return "$nick: Usage: bomb <location>; <location> must be in the form of A15, B3, C9, etc.";
|
|
}
|
|
|
|
# ensure arguments are within range of battlefield
|
|
my ($x, $y) = $arguments =~ m/^(.)(.*)/;
|
|
|
|
$x = ord($x) - 65;
|
|
|
|
if ($x < 0 || $x > $self->{N_Y} || $y < 0 || $y > $self->{N_X}) {
|
|
return "$nick: Target out of range, try again.";
|
|
}
|
|
|
|
# it's not this player's turn, go ahead and store their move
|
|
# for when it is their turn
|
|
if ($self->{state_data}->{current_player} != $player) {
|
|
my $msg;
|
|
if (not exists $self->{state_data}->{players}->[$player]->{location}) {
|
|
$msg = "$nick: You will attack $arguments when it is your turn.";
|
|
}
|
|
else {
|
|
$msg = "$nick: You will now attack $arguments instead of $self->{state_data}->{players}->[$player]->{location} when it is your turn.";
|
|
}
|
|
$self->{state_data}->{players}->[$player]->{location} = $arguments;
|
|
return $msg;
|
|
}
|
|
|
|
# prevent player from attacking multiple times in one turn
|
|
if ($self->{player}->[$player]->{done}) {
|
|
return "$nick: You have already attacked this turn.";
|
|
}
|
|
|
|
# commence attack!
|
|
if ($self->bomb($player, $arguments)) {
|
|
if ($self->{player}->[$player]->{won}) {
|
|
$self->set_state('checkplayer');
|
|
$self->run_one_state;
|
|
} else {
|
|
$self->{player}->[ $player]->{done} = 1;
|
|
$self->{player}->[!$player]->{done} = 0;
|
|
|
|
$self->{state_data}->{current_player} = !$player;
|
|
|
|
$self->{state_data}->{ticks} = 1;
|
|
$self->{state_data}->{first_tock} = 1;
|
|
$self->{state_data}->{tocks} = 0;
|
|
}
|
|
}
|
|
|
|
# bomb() sent bombing output to channel
|
|
return '';
|
|
}
|
|
|
|
when (['specboard', 'board']) {
|
|
if (grep { $_ eq $self->{current_state} } qw/nogame accept genboard gameover/) {
|
|
return "$nick: There is no board to show right now.";
|
|
}
|
|
|
|
# specifically show spectator board, even if invoked by a player
|
|
if ($_ eq 'specboard') {
|
|
$self->show_battlefield(2);
|
|
return '';
|
|
}
|
|
|
|
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
|
|
|
|
# show player's personal board if `id` is playing
|
|
for (my $i = 0; $i < 2; $i++) {
|
|
if ($self->{state_data}->{players}->[$i]->{id} == $id) {
|
|
$self->send_message($channel, "$nick surveys the battlefield!");
|
|
$self->show_battlefield($i);
|
|
return '';
|
|
}
|
|
}
|
|
|
|
# otherwise show spectator board
|
|
$self->show_battlefield(2);
|
|
}
|
|
|
|
# this command shows both player's ships and all information
|
|
when ('fullboard') {
|
|
if (not $self->{pbot}->{users}->loggedin_admin($channel, $hostmask)) {
|
|
return "$nick: Only admins may see the full board.";
|
|
}
|
|
|
|
if (grep { $_ eq $self->{current_state} } qw/nogame accept genboard gameover/) {
|
|
return "$nick: There is no board to show right now.";
|
|
}
|
|
|
|
# show real board if admin is actually in the game ... no cheating!
|
|
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
|
|
for (my $i = 0; $i < 2; $i++) {
|
|
if ($self->{state_data}->{players}->[$i]->{id} == $id) {
|
|
$self->send_message($channel, "$nick surveys the battlefield!");
|
|
$self->show_battlefield($i);
|
|
return '';
|
|
}
|
|
}
|
|
|
|
# show full board
|
|
$self->show_battlefield(4, $nick);
|
|
}
|
|
|
|
default { return $usage; }
|
|
}
|
|
}
|
|
|
|
# add a message to PBot output queue, optionally with a delay
|
|
sub send_message {
|
|
my ($self, $to, $text, $delay) = @_;
|
|
|
|
$delay //= 0;
|
|
|
|
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
|
|
|
|
my $message = {
|
|
nick => $botnick,
|
|
user => 'battleship',
|
|
host => 'localhost',
|
|
hostmask => "$botnick!battleship\@localhost",
|
|
command => 'battleship',
|
|
checkflood => 1,
|
|
message => $text
|
|
};
|
|
|
|
$self->{pbot}->{interpreter}->add_message_to_output_queue($to, $message, $delay);
|
|
}
|
|
|
|
# some colors for IRC messages
|
|
my %color = (
|
|
white => "\x0300",
|
|
black => "\x0301",
|
|
blue => "\x0302",
|
|
green => "\x0303",
|
|
red => "\x0304",
|
|
maroon => "\x0305",
|
|
purple => "\x0306",
|
|
orange => "\x0307",
|
|
yellow => "\x0308",
|
|
lightgreen => "\x0309",
|
|
teal => "\x0310",
|
|
cyan => "\x0311",
|
|
lightblue => "\x0312",
|
|
magneta => "\x0313",
|
|
gray => "\x0314",
|
|
lightgray => "\x0315",
|
|
|
|
bold => "\x02",
|
|
italics => "\x1D",
|
|
underline => "\x1F",
|
|
reverse => "\x16",
|
|
|
|
reset => "\x0F",
|
|
);
|
|
|
|
# battleship stuff
|
|
|
|
sub init_game {
|
|
my ($self, $nick1, $nick2) = @_;
|
|
|
|
$self->{N_X} = 15;
|
|
$self->{N_Y} = 8;
|
|
$self->{SHIPS} = 6;
|
|
|
|
for (my $ship = 0; $ship < $self->{SHIPS}; $ship++) {
|
|
$self->{ship_length}->[$ship] = 0;
|
|
}
|
|
|
|
$self->{board} = [];
|
|
|
|
$self->{player} = [
|
|
{ bombs => 0, hit => 0, miss => 0, sunk => 0, nick => $nick1, done => 0 },
|
|
{ bombs => 0, hit => 0, miss => 0, sunk => 0, nick => $nick2, done => 0 },
|
|
];
|
|
|
|
$self->{horiz} = 0;
|
|
|
|
$self->generate_battlefield;
|
|
}
|
|
|
|
sub count_ship_sections {
|
|
my ($self, $player) = @_;
|
|
|
|
my $sections = 0;
|
|
|
|
for (my $x = 0; $x < $self->{N_Y}; $x++) {
|
|
for (my $y = 0; $y < $self->{N_X}; $y++) {
|
|
if ($player == 0) {
|
|
if ( $self->{board}->[$x][$y] eq $self->{player_two_vert}
|
|
|| $self->{board}->[$x][$y] eq $self->{player_two_horiz})
|
|
{
|
|
$sections++;
|
|
}
|
|
} else {
|
|
if ( $self->{board}->[$x][$y] eq $self->{player_one_vert}
|
|
|| $self->{board}->[$x][$y] eq $self->{player_one_horiz})
|
|
{
|
|
$sections++;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return $sections;
|
|
}
|
|
|
|
sub check_ship {
|
|
my ($self, $x, $y, $o, $d, $l) = @_;
|
|
|
|
my ($xd, $yd, $i);
|
|
|
|
if (!$o) {
|
|
if (!$d) {
|
|
$yd = -1;
|
|
if ($y - $l < 0) {
|
|
return 0;
|
|
}
|
|
} else {
|
|
$yd = 1;
|
|
if ($y + $l >= $self->{N_X}) {
|
|
return 0;
|
|
}
|
|
}
|
|
$xd = 0;
|
|
} else {
|
|
if (!$d) {
|
|
$xd = -1;
|
|
if ($x - $l < 0) {
|
|
return 0;
|
|
}
|
|
} else {
|
|
$xd = 1;
|
|
if ($x + $l >= $self->{N_Y}) {
|
|
return 0;
|
|
}
|
|
}
|
|
$yd = 0;
|
|
}
|
|
|
|
for (my $i = 0; $i < $l; $i++) {
|
|
if ($self->{board}->[$x += $o ? $xd : 0][$y += $o ? 0 : $yd] ne $self->{ocean}) {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub number {
|
|
my ($self, $lower, $upper) = @_;
|
|
return int rand($upper - $lower) + $lower;
|
|
}
|
|
|
|
sub generate_ship {
|
|
my ($self, $player, $ship) = @_;
|
|
|
|
my ($x, $y, $o, $d, $i, $l);
|
|
my ($yd, $xd) = (0, 0);
|
|
|
|
my $fail = 0;
|
|
|
|
while (1) {
|
|
$x = $self->number(0, $self->{N_Y});
|
|
$y = $self->number(0, $self->{N_X});
|
|
|
|
$o = $self->number(1, 10) < 6;
|
|
$d = $self->number(1, 10) < 6;
|
|
|
|
if ($self->{ship_length}->[$ship]) {
|
|
$l = $self->{ship_length}->[$ship];
|
|
} else {
|
|
$l = $self->number(3, 6);
|
|
}
|
|
|
|
if ($self->{debug}) {
|
|
$self->{pbot}->{logger}->log("generate ships player $player: ship $ship x,y: $x,$y o,d: $o,$d length: $l\n");
|
|
}
|
|
|
|
if ($self->check_ship($x, $y, $o, $d, $l)) {
|
|
if (!$o) {
|
|
if ($self->{horiz} < 2) {
|
|
next;
|
|
}
|
|
|
|
if (!$d) {
|
|
$yd = -1;
|
|
} else {
|
|
$yd = 1;
|
|
}
|
|
|
|
$xd = 0;
|
|
} else {
|
|
$self->{horiz}++;
|
|
|
|
if (!$d) {
|
|
$xd = -1;
|
|
} else {
|
|
$xd = 1;
|
|
}
|
|
|
|
$yd = 0;
|
|
}
|
|
|
|
for (my $i = 0; $i < $l; $i++) {
|
|
$self->{board}->[$x += $o ? $xd : 0][$y += $o ? 0 : $yd] =
|
|
$player ? ($o ? $self->{player_two_vert} : $self->{player_two_horiz}) : ($o ? $self->{player_one_vert} : $self->{player_one_horiz});
|
|
}
|
|
|
|
$self->{ship_length}->[$ship] = $l;
|
|
return 1;
|
|
}
|
|
|
|
if (++$fail >= 5000) {
|
|
$self->{pbot}->{logger}->log("Failed to generate ship\n");
|
|
$self->send_message($self->{channel}, "Failed to place a ship. I cannot continue. Game over.");
|
|
$self->set_state('nogame');
|
|
return 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub generate_battlefield {
|
|
my ($self) = @_;
|
|
|
|
for (my $y = 0; $y < $self->{N_Y}; $y++) {
|
|
for (my $x = 0; $x < $self->{N_X}; $x++) {
|
|
$self->{board}->[$y][$x] = $self->{ocean};
|
|
}
|
|
}
|
|
|
|
for (my $x = 0; $x < $self->{SHIPS}; $x++) {
|
|
if (!$self->generate_ship(0, $x) || !$self->generate_ship(1, $x)) {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub check_sunk {
|
|
my ($self, $x, $y, $player) = @_;
|
|
|
|
my $target = $self->{board}->[$x][$y];
|
|
|
|
given ($target) {
|
|
when ($_ eq $self->{player_two_vert} or $_ eq $self->{player_one_vert}) {
|
|
for (my $i = $x + 1; $i < $self->{N_Y}; $i++) {
|
|
if ( ($self->{board}->[$i][$y] eq $self->{player_one_vert} && $player)
|
|
|| ($self->{board}->[$i][$y] eq $self->{player_two_vert} && !$player))
|
|
{
|
|
return 0;
|
|
}
|
|
|
|
if ( $self->{board}->[$i][$y] eq $self->{ocean}
|
|
|| $self->{board}->[$i][$y] eq $self->{player_one_miss}
|
|
|| $self->{board}->[$i][$y] eq $self->{player_two_miss})
|
|
{
|
|
last;
|
|
}
|
|
}
|
|
|
|
for (my $i = $x - 1; $i >= 0; $i--) {
|
|
if ( ($self->{board}->[$i][$y] eq $self->{player_one_vert} && $player)
|
|
|| ($self->{board}->[$i][$y] eq $self->{player_two_vert} && !$player))
|
|
{
|
|
return 0;
|
|
}
|
|
|
|
if ( $self->{board}->[$i][$y] eq $self->{ocean}
|
|
|| $self->{board}->[$i][$y] eq $self->{player_one_miss}
|
|
|| $self->{board}->[$i][$y] eq $self->{player_two_miss})
|
|
{
|
|
last;
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
when ($_ eq $self->{player_one_horiz} or $_ eq $self->{player_two_horiz}) {
|
|
for (my $i = $y + 1; $i < $self->{N_X}; $i++) {
|
|
if ( ($self->{board}->[$x][$i] eq $self->{player_one_horiz} && $player)
|
|
|| ($self->{board}->[$x][$i] eq $self->{player_two_horiz} && !$player))
|
|
{
|
|
return 0;
|
|
}
|
|
|
|
if ($self->{board}->[$x][$i] eq $self->{ocean}
|
|
|| $self->{board}->[$x][$i] eq $self->{player_one_miss}
|
|
|| $self->{board}->[$x][$i] eq $self->{player_two_miss}) {
|
|
last;
|
|
}
|
|
}
|
|
|
|
for (my $i = $y - 1; $i >= 0; $i--) {
|
|
if ( ($self->{board}->[$x][$i] eq $self->{player_one_horiz} && $player)
|
|
|| ($self->{board}->[$x][$i] eq $self->{player_two_horiz} && !$player))
|
|
{
|
|
return 0;
|
|
}
|
|
|
|
if ( $self->{board}->[$x][$i] eq $self->{ocean}
|
|
|| $self->{board}->[$x][$i] eq $self->{player_one_miss}
|
|
|| $self->{board}->[$x][$i] eq $self->{player_two_miss})
|
|
{
|
|
last;
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub bomb {
|
|
my ($self, $player, $location) = @_;
|
|
|
|
my ($hit, $sections, $sunk) = (0, 0, 0, 0, 0);
|
|
|
|
my ($x, $y) = $location =~ /^(.)(.*)/;
|
|
$x = ord($x) - 65;
|
|
$y--;
|
|
|
|
if (!$player) {
|
|
if ( $self->{board}->[$x][$y] eq $self->{player_two_vert}
|
|
|| $self->{board}->[$x][$y] eq $self->{player_two_horiz})
|
|
{
|
|
$hit = 1;
|
|
}
|
|
} else {
|
|
if ( $self->{board}->[$x][$y] eq $self->{player_one_vert}
|
|
|| $self->{board}->[$x][$y] eq $self->{player_one_horiz})
|
|
{
|
|
$hit = 1;
|
|
}
|
|
}
|
|
|
|
$sunk = $self->check_sunk($x, $y, $player);
|
|
|
|
if ($hit) {
|
|
if (!$player) {
|
|
$self->{board}->[$x][$y] = $self->{player_one_hit};
|
|
} else {
|
|
$self->{board}->[$x][$y] = $self->{player_two_hit};
|
|
}
|
|
|
|
$self->{player}->[$player]->{hit}++;
|
|
} else {
|
|
if ($self->{board}->[$x][$y] eq $self->{ocean}) {
|
|
if (!$player) {
|
|
$self->{board}->[$x][$y] = $self->{player_one_miss};
|
|
} else {
|
|
$self->{board}->[$x][$y] = $self->{player_two_miss};
|
|
}
|
|
|
|
$self->{player}->[$player]->{miss}++;
|
|
}
|
|
}
|
|
|
|
my $nick1 = $self->{player}->[ $player]->{nick};
|
|
my $nick2 = $self->{player}->[!$player]->{nick};
|
|
|
|
my @attacks = (
|
|
"launches torpedoes at",
|
|
"launches nukes at",
|
|
"fires cannons at",
|
|
"fires torpedoes at",
|
|
"fires nukes at",
|
|
"launches tomahawk missiles at",
|
|
"fires a gatling gun at",
|
|
"launches ballistic missiles at",
|
|
);
|
|
|
|
my $attacked = $attacks[rand @attacks];
|
|
|
|
if ($hit) {
|
|
$self->send_message($self->{channel}, "$nick1 $attacked $nick2 at $location! $color{red}--- HIT! --- $color{reset}");
|
|
|
|
$self->{player}->[$player]->{destroyed}++;
|
|
|
|
if ($sunk) {
|
|
$self->{player}->[$player]->{sunk}++;
|
|
my $remaining = $self->count_ship_sections($player);
|
|
$self->send_message($self->{channel}, "$color{red}$nick1 has sunk ${nick2}'s ship! $remaining ship section" . ($remaining != 1 ? 's' : '') . " remaining!$color{reset}");
|
|
|
|
if ($remaining == 0) {
|
|
$self->send_message($self->{channel}, "$nick1 has WON the game of Battleship!");
|
|
$self->{player}->[$player]->{won} = 1;
|
|
}
|
|
}
|
|
} else {
|
|
$self->send_message($self->{channel}, "$nick1 $attacked $nick2 at $location! --- miss ---");
|
|
}
|
|
|
|
$self->{player}->[$player]->{bombs}++;
|
|
return 1;
|
|
}
|
|
|
|
sub show_scoreboard {
|
|
my ($self) = @_;
|
|
|
|
my $p1sections = $self->count_ship_sections(1);
|
|
my $p2sections = $self->count_ship_sections(0);
|
|
|
|
my $p1win = '';
|
|
my $p2win = '';
|
|
|
|
if ($p1sections > $p2sections) {
|
|
$p1win = "$color{bold}$color{lightgreen} * ";
|
|
$p2win = "$color{red} ";
|
|
} elsif ($p1sections < $p2sections) {
|
|
$p1win = "$color{red} ";
|
|
$p2win = "$color{bold}$color{lightgreen} * ";
|
|
}
|
|
|
|
my $length_a = length $self->{player}->[0]->{nick};
|
|
my $length_b = length $self->{player}->[1]->{nick};
|
|
my $longest = $length_a > $length_b ? $length_a : $length_b;
|
|
|
|
my $bombslen = ($self->{player}->[0]->{bombs} > 10 || $self->{player}->[1]->{bombs} > 10) ? 2 : 1;
|
|
my $hitlen = ($self->{player}->[0]->{hit} > 10 || $self->{player}->[1]->{hit} > 10) ? 2 : 1;
|
|
my $misslen = ($self->{player}->[0]->{miss} > 10 || $self->{player}->[1]->{miss} > 10) ? 2 : 1;
|
|
my $sunklen = ($self->{player}->[0]->{sunk} > 10 || $self->{player}->[1]->{sunk} > 10) ? 2 : 1;
|
|
my $intactlen = ($p1sections > 10 || $p2sections > 10) ? 2 : 1;
|
|
|
|
my $p1bombscolor = $self->{player}->[0]->{bombs} > $self->{player}->[1]->{bombs} ? $color{green} : $color{red};
|
|
my $p1hitcolor = $self->{player}->[0]->{hit} > $self->{player}->[1]->{hit} ? $color{green} : $color{red};
|
|
my $p1misscolor = $self->{player}->[0]->{miss} < $self->{player}->[1]->{miss} ? $color{green} : $color{red};
|
|
my $p1sunkcolor = $self->{player}->[0]->{sunk} > $self->{player}->[1]->{sunk} ? $color{green} : $color{red};
|
|
my $p1intactcolor = $p1sections > $p2sections ? $color{green} : $color{red};
|
|
|
|
my $p2bombscolor = $self->{player}->[0]->{bombs} < $self->{player}->[1]->{bombs} ? $color{green} : $color{red};
|
|
my $p2hitcolor = $self->{player}->[0]->{hit} < $self->{player}->[1]->{hit} ? $color{green} : $color{red};
|
|
my $p2misscolor = $self->{player}->[0]->{miss} > $self->{player}->[1]->{miss} ? $color{green} : $color{red};
|
|
my $p2sunkcolor = $self->{player}->[0]->{sunk} < $self->{player}->[1]->{sunk} ? $color{green} : $color{red};
|
|
my $p2intactcolor = $p1sections < $p2sections ? $color{green} : $color{red};
|
|
|
|
my $buf;
|
|
|
|
$buf = sprintf(
|
|
"$p1win%*s$color{reset}: bomb: $p1bombscolor%*d$color{reset}, hit: $p1hitcolor%*d$color{reset}, miss: $p1misscolor%*d$color{reset}, sunk: $p1sunkcolor%*d$color{reset}, sections left: $p1intactcolor%*d$color{reset}",
|
|
$longest, $self->{player}->[0]->{nick}, $bombslen, $self->{player}->[0]->{bombs},
|
|
$hitlen, $self->{player}->[0]->{hit}, $misslen, $self->{player}->[0]->{miss},
|
|
$sunklen, $self->{player}->[0]->{sunk}, $intactlen, $p1sections
|
|
);
|
|
|
|
$self->send_message($self->{channel}, $buf);
|
|
|
|
$buf = sprintf(
|
|
"$p2win%*s$color{reset}: bomb: $p2bombscolor%*d$color{reset}, hit: $p2hitcolor%*d$color{reset}, miss: $p2misscolor%*d$color{reset}, sunk: $p2sunkcolor%*d$color{reset}, sections left: $p2intactcolor%*d$color{reset}",
|
|
$longest, $self->{player}->[1]->{nick}, $bombslen, $self->{player}->[1]->{bombs},
|
|
$hitlen, $self->{player}->[1]->{hit}, $misslen, $self->{player}->[1]->{miss},
|
|
$sunklen, $self->{player}->[1]->{sunk}, $intactlen, $p2sections
|
|
);
|
|
|
|
$self->send_message($self->{channel}, $buf);
|
|
}
|
|
|
|
sub show_battlefield {
|
|
my ($self, $player, $nick) = @_;
|
|
|
|
$self->{pbot}->{logger}->log("Showing battlefield for player $player\n");
|
|
|
|
my $buf = "$color{cyan},01 ";
|
|
|
|
for (my $x = 1; $x < $self->{N_X} + 1; $x++) {
|
|
if ($x % 10 == 0) {
|
|
$buf .= "$color{yellow},01" if $self->{N_X} > 10;
|
|
$buf .= $x % 10;
|
|
$buf .= ' ';
|
|
$buf .= "$color{cyan},01" if $self->{N_X} > 10;
|
|
} else {
|
|
$buf .= $x % 10;
|
|
$buf .= ' ';
|
|
}
|
|
}
|
|
|
|
$buf .= "\n";
|
|
|
|
for (my $y = 0; $y < $self->{N_Y}; $y++) {
|
|
|
|
$buf .= sprintf("$color{cyan},01%c ", 97 + $y);
|
|
|
|
for (my $x = 0; $x < $self->{N_X}; $x++) {
|
|
|
|
if ($player == 0) {
|
|
if ($self->{board}->[$y][$x] eq $self->{player_two_vert}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_two_horiz})
|
|
{
|
|
$buf .= "$color{blue},01$self->{ocean} ";
|
|
next;
|
|
} else {
|
|
if ($self->{board}->[$y][$x] eq $self->{player_one_hit}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_two_hit})
|
|
{
|
|
$buf .= "$color{red},01";
|
|
}
|
|
elsif ($self->{board}->[$y][$x] eq $self->{player_two_miss}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_one_miss})
|
|
{
|
|
$buf .= "$color{cyan},01";
|
|
}
|
|
elsif ($self->{board}->[$y][$x] eq $self->{ocean})
|
|
{
|
|
$buf .= "$color{blue},01$self->{ocean} ";
|
|
next;
|
|
} else {
|
|
$buf .= "$color{white},01";
|
|
}
|
|
|
|
$buf .= "$self->{board}->[$y][$x] ";
|
|
}
|
|
} elsif ($player == 1) {
|
|
if ($self->{board}->[$y][$x] eq $self->{player_one_vert}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_one_horiz})
|
|
{
|
|
$buf .= "$color{blue},01$self->{ocean} ";
|
|
next;
|
|
} else {
|
|
if ($self->{board}->[$y][$x] eq $self->{player_one_hit}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_two_hit})
|
|
{
|
|
$buf .= "$color{red},01";
|
|
}
|
|
elsif ($self->{board}->[$y][$x] eq $self->{player_two_miss}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_one_miss})
|
|
{
|
|
$buf .= "$color{cyan},01";
|
|
}
|
|
elsif ($self->{board}->[$y][$x] eq $self->{ocean})
|
|
{
|
|
$buf .= "$color{blue},01$self->{ocean} ";
|
|
next;
|
|
} else {
|
|
$buf .= "$color{white},01";
|
|
}
|
|
|
|
$buf .= "$self->{board}->[$y][$x] ";
|
|
}
|
|
} elsif ($player == 2) {
|
|
if ($self->{board}->[$y][$x] eq $self->{player_one_vert}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_one_horiz}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_two_vert}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_two_horiz})
|
|
{
|
|
$buf .= "$color{blue},01$self->{ocean} ";
|
|
next;
|
|
} else {
|
|
if ($self->{board}->[$y][$x] eq $self->{player_one_hit}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_two_hit})
|
|
{
|
|
$buf .= "$color{red},01";
|
|
}
|
|
elsif ($self->{board}->[$y][$x] eq $self->{player_two_miss}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_one_miss})
|
|
{
|
|
$buf .= "$color{cyan},01";
|
|
}
|
|
elsif ($self->{board}->[$y][$x] eq $self->{ocean})
|
|
{
|
|
$buf .= "$color{blue},01$self->{ocean} ";
|
|
next;
|
|
} else {
|
|
$buf .= "$color{white},01";
|
|
}
|
|
|
|
$buf .= "$self->{board}->[$y][$x] ";
|
|
}
|
|
} else {
|
|
if ($self->{board}->[$y][$x] eq $self->{player_one_hit}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_two_hit})
|
|
{
|
|
$buf .= "$color{red},01";
|
|
}
|
|
elsif ($self->{board}->[$y][$x] eq $self->{player_two_miss}
|
|
|| $self->{board}->[$y][$x] eq $self->{player_one_miss})
|
|
{
|
|
$buf .= "$color{cyan},01";
|
|
}
|
|
elsif ($self->{board}->[$y][$x] eq $self->{ocean})
|
|
{
|
|
$buf .= "$color{blue},01$self->{ocean} ";
|
|
next;
|
|
} else {
|
|
$buf .= "$color{white},01";
|
|
}
|
|
|
|
$buf .= "$self->{board}->[$y][$x] ";
|
|
}
|
|
}
|
|
|
|
$buf .= sprintf("$color{cyan},01%c", 97 + $y);
|
|
$buf .= "$color{reset}\n";
|
|
}
|
|
|
|
# bottom border
|
|
$buf .= "$color{cyan},01 ";
|
|
|
|
for (my $x = 1; $x < $self->{N_X} + 1; $x++) {
|
|
if ($x % 10 == 0) {
|
|
$buf .= $color{yellow}, 01 if $self->{N_X} > 10;
|
|
$buf .= $x % 10;
|
|
$buf .= ' ';
|
|
$buf .= $color{cyan}, 01 if $self->{N_X} > 10;
|
|
} else {
|
|
$buf .= $x % 10;
|
|
$buf .= ' ';
|
|
}
|
|
}
|
|
|
|
$buf .= "\n";
|
|
|
|
my $player1 = $self->{player}->[0]->{nick};
|
|
my $player2 = $self->{player}->[1]->{nick};
|
|
|
|
if ($player == 0) {
|
|
$self->send_message(
|
|
$self->{player}->[$player]->{nick},
|
|
"Player One Legend: ships: [$self->{player_one_vert} $self->{player_one_horiz}] ocean: [$color{blue},01$self->{ocean}$color{reset}] $player1 miss: [$color{cyan},01$self->{player_one_miss}$color{reset}] $player2 miss: [$color{cyan},01$self->{player_two_miss}$color{reset}] $player1 hit: [$color{red},01"
|
|
. $self->{player_one_hit}
|
|
. "$color{reset}] $player2 hit: [$color{red},01$self->{player_two_hit}$color{reset}]"
|
|
);
|
|
} elsif ($player == 1) {
|
|
$self->send_message(
|
|
$self->{player}->[$player]->{nick},
|
|
"Player Two Legend: ships: [$self->{player_two_vert} $self->{player_two_horiz}] ocean: [$color{blue},01$self->{ocean}$color{reset}] $player1 miss: [$color{cyan},01$self->{player_one_miss}$color{reset}] $player2 miss: [$color{cyan},01$self->{player_two_miss}$color{reset}] $player1 hit: [$color{red},01"
|
|
. $self->{player_one_hit}
|
|
. "$color{reset}] $player2 hit: [$color{red},01$self->{player_two_hit}$color{reset}]"
|
|
);
|
|
} elsif ($player == 2) {
|
|
$self->send_message(
|
|
$self->{channel},
|
|
"Spectator Legend: ocean: [$color{blue},01$self->{ocean}$color{reset}] $player1 miss: [$color{cyan},01$self->{player_one_miss}$color{reset}] $player2 miss: [$color{cyan},01$self->{player_two_miss}$color{reset}] $player1 hit: [$color{red},01"
|
|
. $self->{player_one_hit}
|
|
. "$color{reset}] $player2 hit: [$color{red},01$self->{player_two_hit}$color{reset}]"
|
|
);
|
|
} elsif ($player == 3) {
|
|
$self->send_message(
|
|
$self->{channel},
|
|
"Final Board Legend: $player1 ships: [$self->{player_one_vert} $self->{player_one_horiz}] $player2 ships: [$self->{player_two_vert} $self->{player_two_horiz}] ocean: [$color{blue},01$self->{ocean}$color{reset}] $player1 miss: [$color{cyan},01$self->{player_one_miss}$color{reset}] $player2 miss: [$color{cyan},01$self->{player_two_miss}$color{reset}] $player1 hit: [$color{red},01"
|
|
. $self->{player_one_hit}
|
|
. "$color{reset}] $player2 hit: [$color{red},01$self->{player_two_hit}$color{reset}]"
|
|
);
|
|
} else {
|
|
$self->send_message(
|
|
$nick,
|
|
"Full Board Legend: $player1 ships: [$self->{player_one_vert} $self->{player_one_horiz}] $player2 ships: [$self->{player_two_vert} $self->{player_two_horiz}] ocean: [$color{blue},01$self->{ocean}$color{reset}] $player1 miss: [$color{cyan},01$self->{player_one_miss}$color{reset}] $player2 miss: [$color{cyan},01$self->{player_two_miss}$color{reset}] $player1 hit: [$color{red},01"
|
|
. $self->{player_one_hit}
|
|
. "$color{reset}] $player2 hit: [$color{red},01$self->{player_two_hit}$color{reset}]"
|
|
);
|
|
}
|
|
|
|
foreach my $line (split /\n/, $buf) {
|
|
if ($player == 0 || $player == 1) {
|
|
$self->send_message($self->{player}->[$player]->{nick}, $line);
|
|
}
|
|
elsif ($player == 2 || $player == 3) {
|
|
$self->send_message($self->{channel}, $line);
|
|
}
|
|
else {
|
|
$self->send_message($nick, $line);
|
|
}
|
|
}
|
|
}
|
|
|
|
# game state machine stuff
|
|
|
|
# do one loop of the game engine
|
|
sub run_one_state {
|
|
my ($self) = @_;
|
|
|
|
# check for naughty or missing players
|
|
for (my $i = 0; $i < @{$self->{state_data}->{players}}; $i++) {
|
|
if ($self->{state_data}->{players}->[$i]->{missedinputs} >= 3) {
|
|
# remove player if they have missed 3 inputs
|
|
$self->send_message(
|
|
$self->{channel},
|
|
"$color{red}$self->{state_data}->{players}->[$i]->{name} has missed too many prompts and has been ejected from the game!$color{reset}"
|
|
);
|
|
|
|
$self->{state_data}->{players}->[$i]->{removed} = 1;
|
|
}
|
|
|
|
if ($self->{state_data}->{players}->[$i]->{removed}) {
|
|
# end game if a player has been removed
|
|
$self->set_state('gameover');
|
|
last;
|
|
}
|
|
}
|
|
|
|
# transitioned to a brand new state; prepare first tock
|
|
if ($self->{previous_state} ne $self->{current_state}) {
|
|
$self->{state_data}->{ticks} = 1;
|
|
$self->{state_data}->{first_tock} = 1;
|
|
$self->{state_data}->{tocks} = 0;
|
|
|
|
# dump new state data for logging/debugging
|
|
if ($self->{debug}) {
|
|
$Data::Dumper::Useqq = 1;
|
|
$Data::Dumper::Sortkeys = 1;
|
|
$self->{pbot}->{logger}->log("Battleship: New state: $self->{current_state}\n" . Dumper $self->{state_data});
|
|
}
|
|
}
|
|
|
|
# run one state/tick
|
|
$self->{states}->{$self->{current_state}}->{sub}->($self->{state_data});
|
|
|
|
# transition to next state
|
|
$self->{previous_state} = $self->{current_state};
|
|
$self->{current_state} = $self->{states}->{$self->{current_state}}->{trans}->{$self->{state_data}->{trans}};
|
|
|
|
# reset tick-tock once we've tocked
|
|
if ($self->{state_data}->{tocked}) {
|
|
$self->{state_data}->{tocked} = 0;
|
|
$self->{state_data}->{ticks} = 0;
|
|
$self->{state_data}->{first_tock} = 0;
|
|
}
|
|
|
|
# next tick
|
|
$self->{state_data}->{ticks}++;
|
|
}
|
|
|
|
# skip directly to a state
|
|
sub set_state {
|
|
my ($self, $newstate) = @_;
|
|
$self->{previous_state} = $self->{current_state};
|
|
$self->{current_state} = $newstate;
|
|
$self->{state_data}->{ticks} = 0;
|
|
}
|
|
|
|
# set up game state machine
|
|
sub create_states {
|
|
my ($self) = @_;
|
|
|
|
$self->{pbot}->{logger}->log("Battleship: Creating game state machine\n");
|
|
|
|
# initialize default state
|
|
$self->{previous_state} = '';
|
|
$self->{current_state} = 'nogame';
|
|
|
|
# initialize state data
|
|
$self->{state_data} = {
|
|
players => [], # array of player data
|
|
ticks => 0, # number of ticks elapsed
|
|
current_player => 0, # whose turn is it?
|
|
};
|
|
|
|
$self->{states} = {
|
|
nogame => {
|
|
sub => sub { $self->nogame(@_) },
|
|
|
|
trans => {
|
|
challenge => 'accept',
|
|
nogame => 'nogame',
|
|
}
|
|
},
|
|
|
|
accept => {
|
|
sub => sub { $self->accept(@_) },
|
|
|
|
trans => {
|
|
stop => 'nogame',
|
|
wait => 'accept',
|
|
accept => 'genboard',
|
|
}
|
|
},
|
|
|
|
genboard => {
|
|
sub => sub { $self->genboard(@_) },
|
|
|
|
trans => {
|
|
next => 'showboard',
|
|
}
|
|
},
|
|
|
|
showboard => {
|
|
sub => sub { $self->showboard(@_) },
|
|
|
|
trans => {
|
|
next => 'playermove',
|
|
}
|
|
},
|
|
|
|
playermove => {
|
|
sub => sub { $self->playermove(@_) },
|
|
|
|
trans => {
|
|
wait => 'playermove',
|
|
next => 'checkplayer',
|
|
}
|
|
},
|
|
|
|
checkplayer => {
|
|
sub => sub { $self->checkplayer(@_) },
|
|
|
|
trans => {
|
|
gotwinner => 'gameover',
|
|
next => 'playermove',
|
|
}
|
|
},
|
|
|
|
gameover => {
|
|
sub => sub { $self->gameover(@_) },
|
|
|
|
trans => {
|
|
wait => 'gameover',
|
|
next => 'nogame',
|
|
}
|
|
},
|
|
};
|
|
}
|
|
|
|
# game states
|
|
|
|
sub nogame {
|
|
my ($self, $state) = @_;
|
|
$state->{trans} = 'nogame';
|
|
$self->{pbot}->{event_queue}->update_repeating('battleship loop', 0);
|
|
}
|
|
|
|
sub accept {
|
|
my ($self, $state) = @_;
|
|
|
|
$state->{tock_limit} = 3;
|
|
|
|
if ($state->{players}->[1]->{accepted}) {
|
|
$state->{trans} = 'accept';
|
|
return;
|
|
}
|
|
|
|
my $tock = 15;
|
|
|
|
if ($state->{ticks} % $tock == 0) {
|
|
$state->{tocked} = 1;
|
|
|
|
if (++$state->{tocks} > $state->{tock_limit}) {
|
|
if ($state->{players}->[1]->{id} == -1) { $self->send_message($self->{channel}, "Nobody has accepted $state->{players}->[0]->{name}'s challenge."); }
|
|
else { $self->send_message($self->{channel}, "$state->{players}->[1]->{name} has failed to accept $state->{players}->[0]->{name}'s challenge."); }
|
|
$state->{trans} = 'stop';
|
|
$state->{players} = [];
|
|
return;
|
|
}
|
|
|
|
if ($state->{players}->[1]->{id} == -1) {
|
|
$self->send_message($self->{channel}, "$state->{players}->[0]->{name} has made an open challenge! Use `accept` to accept their challenge.");
|
|
} else {
|
|
$self->send_message($self->{channel}, "$state->{players}->[1]->{name}: $state->{players}->[0]->{name} has challenged you! Use `accept` to accept their challenge.");
|
|
}
|
|
}
|
|
|
|
$state->{trans} = 'wait';
|
|
}
|
|
|
|
sub genboard {
|
|
my ($self, $state) = @_;
|
|
$self->init_game($state->{players}->[0]->{name}, $state->{players}->[1]->{name});
|
|
$state->{current_player} = 0;
|
|
$state->{tock_limit} = 3;
|
|
$state->{trans} = 'next';
|
|
}
|
|
|
|
sub showboard {
|
|
my ($self, $state) = @_;
|
|
$self->send_message($self->{channel}, "Showing battlefield to $self->{player}->[0]->{nick}...");
|
|
$self->show_battlefield(0);
|
|
$self->send_message($self->{channel}, "Showing battlefield to $self->{player}->[1]->{nick}...");
|
|
$self->show_battlefield(1);
|
|
$self->send_message($self->{channel}, "Fight! Anybody (players and spectators) can use `board` at any time to see the battlefield.");
|
|
$state->{trans} = 'next';
|
|
}
|
|
|
|
sub playermove {
|
|
my ($self, $state) = @_;
|
|
|
|
my $tock = 15;
|
|
|
|
if ($state->{first_tock}) {
|
|
$tock = 3;
|
|
}
|
|
|
|
if ($self->{player}->[$state->{current_player}]->{done}) {
|
|
$state->{trans} = 'next';
|
|
return;
|
|
}
|
|
|
|
my $player = $state->{current_player};
|
|
my $location = delete $state->{players}->[$player]->{location};
|
|
|
|
if (defined $location) {
|
|
if ($self->bomb($player, $location)) {
|
|
$self->{player}->[$player]->{done} = 1;
|
|
$self->{player}->[!$player]->{done} = 0;
|
|
$self->{state_data}->{current_player} = !$player;
|
|
$state->{trans} = 'next';
|
|
return;
|
|
}
|
|
}
|
|
|
|
if ($state->{ticks} % $tock == 0) {
|
|
$state->{tocked} = 1;
|
|
|
|
if (++$state->{tocks} > $state->{tock_limit}) {
|
|
$state->{players}->[$state->{current_player}]->{missedinputs}++;
|
|
$self->send_message($self->{channel}, "$state->{players}->[$state->{current_player}]->{name} failed to launch an attack in time. They forfeit their turn!");
|
|
|
|
$self->{player}->[$state->{current_player}]->{done} = 1;
|
|
$self->{player}->[!$state->{current_player}]->{done} = 0;
|
|
$state->{current_player} = !$state->{current_player};
|
|
$state->{trans} = 'next';
|
|
return;
|
|
}
|
|
|
|
my $red = $state->{tocks} == $state->{tock_limit} ? $color{red} : '';
|
|
|
|
my $remaining = 15 * $state->{tock_limit};
|
|
$remaining -= 15 * ($state->{tocks} - 1);
|
|
$remaining = "(" . (concise duration $remaining) . " remaining)";
|
|
|
|
$self->send_message($self->{channel}, "$state->{players}->[$state->{current_player}]->{name}: $red$remaining Launch an attack now via `bomb <location>`!$color{reset}");
|
|
}
|
|
|
|
$state->{trans} = 'wait';
|
|
}
|
|
|
|
sub checkplayer {
|
|
my ($self, $state) = @_;
|
|
|
|
if ($self->{player}->[0]->{won} or $self->{player}->[1]->{won}) {
|
|
$state->{trans} = 'gotwinner';
|
|
} else {
|
|
$state->{trans} = 'next';
|
|
}
|
|
}
|
|
|
|
sub gameover {
|
|
my ($self, $state) = @_;
|
|
|
|
if ($state->{ticks} % 5 == 0) {
|
|
if ($state->{players}->[1]->{id} != -1 && $state->{players}->[1]->{accepted}) {
|
|
$self->show_battlefield(3);
|
|
$self->show_scoreboard;
|
|
$self->send_message($self->{channel}, "Game over!");
|
|
}
|
|
|
|
$state->{players} = [];
|
|
$state->{tocks} = 0;
|
|
$state->{trans} = 'next';
|
|
} else {
|
|
$state->{trans} = 'wait';
|
|
}
|
|
}
|
|
|
|
1;
|