summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2014-10-22 14:00:01 -0400
committerJesse Luehrs <doy@tozt.net>2014-10-22 14:00:01 -0400
commit2a247f922192e15d9d7cb70edbcf589c86d044a9 (patch)
tree00c76627011d87110fb40ec24ab970c7f65ecabc
parent0a01e4fcb5c725ccf6642d6d517ea2a9bc624a44 (diff)
downloadBot-Zulip-Chess-2a247f922192e15d9d7cb70edbcf589c86d044a9.tar.gz
Bot-Zulip-Chess-2a247f922192e15d9d7cb70edbcf589c86d044a9.zip
initial implementation
-rw-r--r--bin/chessbot9
-rw-r--r--lib/Bot/Zulip/Chess.pm237
2 files changed, 246 insertions, 0 deletions
diff --git a/bin/chessbot b/bin/chessbot
new file mode 100644
index 0000000..c007ad6
--- /dev/null
+++ b/bin/chessbot
@@ -0,0 +1,9 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Bot::Zulip::Chess;
+use JSON::PP;
+
+my $config = decode_json(scalar do { local $/; <> });
+Bot::Zulip::Chess->new($config)->run;
diff --git a/lib/Bot/Zulip/Chess.pm b/lib/Bot/Zulip/Chess.pm
index e69de29..6180ee9 100644
--- a/lib/Bot/Zulip/Chess.pm
+++ b/lib/Bot/Zulip/Chess.pm
@@ -0,0 +1,237 @@
+package Bot::Zulip::Chess;
+use 5.020;
+use feature 'signatures', 'postderef';
+use experimental 'signatures', 'postderef';
+use Moose;
+no warnings 'experimental::signatures';
+no warnings 'experimental::postderef';
+
+use Chess::Rep;
+use Try::Tiny;
+use WebService::Zulip;
+
+has api_key => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+has api_user => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+has bot_name => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+has white_player => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_white_player',
+ clearer => 'clear_white_player',
+);
+
+has black_player => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_black_player',
+ clearer => 'clear_black_player',
+);
+
+has turn => (
+ is => 'rw',
+ isa => 'Str',
+ default => 'white',
+);
+
+has _zulip => (
+ is => 'ro',
+ isa => 'WebService::Zulip',
+ lazy => 1,
+ default => sub ($self) {
+ WebService::Zulip->new(
+ api_key => $self->api_key,
+ api_user => $self->api_user,
+ )
+ },
+);
+
+has _queue => (
+ is => 'ro',
+ isa => 'HashRef',
+ lazy => 1,
+ default => sub ($self) {
+ $self->_zulip->get_message_queue
+ },
+);
+
+has _chessboard => (
+ is => 'ro',
+ isa => 'Chess::Rep',
+ lazy => 1,
+ default => sub { Chess::Rep->new },
+ clearer => '_clear_chessboard',
+);
+
+sub run ($self) {
+ while (1) {
+ $self->step
+ }
+}
+
+sub step ($self) {
+ my $res = $self->_zulip->get_new_events(
+ queue_id => $self->_queue->{queue_id},
+ last_event_id => $self->_queue->{last_event_id},
+ dont_block => 'false',
+ );
+ for my $event ($res->{events}->@*) {
+ next unless $event->{type} eq 'message';
+ my $message = $event->{message};
+ # next if $message->{type} eq 'private';
+ my $bot_name = $self->bot_name;
+ my $content = $message->{content};
+ next unless $content =~ s/^\@\*\*$bot_name\*\*//;
+ $content =~ s/^\s*|\s*$//g;
+ my $response = $self->handle_move(
+ $message->{sender_full_name}, $content
+ );
+ $self->_zulip->send_message(
+ content => $response,
+ subject => $message->{subject},
+ to => $message->{sender_email},
+ type => $message->{type},
+ );
+ }
+ $self->_queue->{last_event_id} = $self->_zulip->get_last_event_id($res);
+}
+
+sub handle_move ($self, $player, $move) {
+ if ($self->needs_new_player) {
+ $self->set_new_player($player);
+ }
+
+ if (!$self->players_turn($player)) {
+ return "It's not your turn!";
+ }
+ else {
+ return try {
+ $self->_chessboard->go_move($move);
+ my $state = $self->draw_state;
+ $self->increment_turn;
+ $state
+ }
+ catch {
+ s/ at .* line .*//r;
+ };
+ }
+}
+
+sub needs_new_player ($self) {
+ return !$self->has_white_player || !$self->has_black_player
+}
+
+sub set_new_player ($self, $player) {
+ if (!$self->has_white_player) {
+ $self->white_player($player)
+ }
+ elsif (!$self->has_black_player) {
+ $self->black_player($player);
+ }
+ else {
+ die "Both players are already full";
+ }
+}
+
+sub increment_turn ($self) {
+ $self->turn($self->turn eq 'white' ? 'black' : 'white');
+}
+
+sub draw_state ($self) {
+ my $board = $self->format_board =~ s/^/ /gmr;
+ my $status = $self->_chessboard->status;
+
+ if ($status->{mate}) {
+ $board .= "\nCHECKMATE\n";
+ $self->reset_board;
+ }
+ elsif ($status->{stalemate}) {
+ $board .= "\nSTALEMATE\n";
+ $self->reset_board;
+ }
+ elsif ($status->{check}) {
+ $board .= "\nCHECK\n";
+ }
+
+ return $board;
+}
+
+sub players_turn ($self, $player) {
+ my $method = $self->turn . '_player';
+ my $expected_player = $self->$method;
+ return 1 if !defined($expected_player);
+ return 1 if $expected_player eq $player;
+ return;
+}
+
+sub reset_board ($self) {
+ $self->turn('white');
+ $self->clear_white_player;
+ $self->clear_black_player;
+ $self->_clear_chessboard;
+}
+
+my %pieces = (
+ p => "\N{BLACK CHESS PAWN}",
+ P => "\N{WHITE CHESS PAWN}",
+ n => "\N{BLACK CHESS KNIGHT}",
+ N => "\N{WHITE CHESS KNIGHT}",
+ b => "\N{BLACK CHESS BISHOP}",
+ B => "\N{WHITE CHESS BISHOP}",
+ r => "\N{BLACK CHESS ROOK}",
+ R => "\N{WHITE CHESS ROOK}",
+ q => "\N{BLACK CHESS QUEEN}",
+ Q => "\N{WHITE CHESS QUEEN}",
+ k => "\N{BLACK CHESS KING}",
+ K => "\N{WHITE CHESS KING}",
+);
+sub format_board ($self) {
+ my $board = $self->_chessboard->dump_pos;
+
+ for my $piece (keys %pieces) {
+ $board =~ s/$piece/$pieces{$piece}/g;
+ }
+
+ $board =~ s/\+/\N{BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL}/g;
+ $board =~ s/\|-/\N{BOX DRAWINGS LIGHT VERTICAL AND RIGHT}-/g;
+ $board =~ s/-\|/-\N{BOX DRAWINGS LIGHT VERTICAL AND LEFT}/g;
+ $board =~ s/\|/\N{BOX DRAWINGS LIGHT VERTICAL}/g;
+ $board =~ s/-/\N{BOX DRAWINGS LIGHT HORIZONTAL}/g;
+
+ $board = "\N{BOX DRAWINGS LIGHT DOWN AND RIGHT}"
+ . ("\N{BOX DRAWINGS LIGHT HORIZONTAL}\N{BOX DRAWINGS LIGHT DOWN AND HORIZONTAL}" x 7) . "\N{BOX DRAWINGS LIGHT HORIZONTAL}"
+ . "\N{BOX DRAWINGS LIGHT DOWN AND LEFT}"
+ . "\n" . $board . "\n"
+ . "\N{BOX DRAWINGS LIGHT UP AND RIGHT}"
+ . ("\N{BOX DRAWINGS LIGHT HORIZONTAL}\N{BOX DRAWINGS LIGHT UP AND HORIZONTAL}" x 7) . "\N{BOX DRAWINGS LIGHT HORIZONTAL}"
+ . "\N{BOX DRAWINGS LIGHT UP AND LEFT}"
+ . "\n A B C D E F G H\n";
+
+ my @board = split "\n", $board;
+ my $n = 1;
+ for my $i (0..$#board) {
+ my $prefix = $i % 2 == 1 && $i < 16 ? $n++ : " ";
+ $board[$i] = $prefix . $board[$i];
+ }
+
+ join("\n", @board)
+}
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;