diff options
Diffstat (limited to 'lib/Bot/Zulip/Chess.pm')
| -rw-r--r-- | lib/Bot/Zulip/Chess.pm | 237 |
1 files changed, 237 insertions, 0 deletions
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; |