view release on metacpan or  search on metacpan

lib/Chess/Game.pm  view on Meta::CPAN

	$obj_data->{message} = "Not your turn";
	return 0;
    }
    return 0 unless ($piece->can_reach($sq2));
    my $capture = $board->get_piece_at($sq2);
    if (defined($capture)) {
	unless ($capture->get_player() ne $player) {
	    $obj_data->{message} = "You can't capture your own piece";
	    return 0;
	}
	if ($piece->isa('Chess::Piece::Pawn')) {
	    unless (abs(Chess::Board->horz_distance($sq1, $sq2)) == 1) {
		$obj_data->{message} = "Pawns may only capture diagonally";
		return 0;
	    }
	}
	elsif ($piece->isa('Chess::Piece::King')) {
	    unless (abs(Chess::Board->horz_distance($sq1, $sq2)) < 2) {
		$obj_data->{message} = "You can't capture while castling";
		return 0;
	    }
	}
    }
    else {
	if ($piece->isa('Chess::Piece::Pawn')) {
	    my $ml = $obj_data->{movelist};
	    unless (Chess::Board->horz_distance($sq1, $sq2) == 0 or
	            _is_valid_en_passant($obj_data, $piece, $sq1, $sq2)) {
		$obj_data->{message} = "Pawns must capture on a diagonal move";
		return 0;
	    }
	}
    }
    my $valid_castle = 0;
    my $clone = $self->clone();
    my $r_clone = _get_game($$clone);
    my $king = $r_clone->{_kings}[($player eq $player1 ? 0 : 1)];
    if ($piece->isa('Chess::Piece::King')) {
	my $hdist = Chess::Board->horz_distance($sq1, $sq2);
	if (abs($hdist) == 2) {
	    _mark_threatened_kings($r_clone);
	    unless (!$king->threatened()) {
		$obj_data->{message} = "Can't castle out of check";
		return 0;
	    }
	    if ($hdist > 0) {
		return 0 unless (_is_valid_short_castle($obj_data, $piece, $sq1, $sq2));
		$valid_castle = MOVE_CASTLE_SHORT;
	    }
	    else {
		return 0 unless (_is_valid_long_castle($obj_data, $piece, $sq1, $sq2));
		$valid_castle = MOVE_CASTLE_LONG;
	    }
	}
    }
    elsif (!$piece->isa('Chess::Piece::Knight')) {
	my $board_c = $board->clone();
	$board_c->set_piece_at($sq1, undef);
	$board_c->set_piece_at($sq2, undef);
	unless ($board_c->line_is_open($sq1, $sq2)) {
	    $obj_data->{message} = "Line '$sq1' - '$sq2' is blocked";
	    return 0;
	}
    }
    if (!$valid_castle) {
	$clone->make_move($sq1, $sq2, 0);
	_mark_threatened_kings($r_clone);
	unless (!$king->threatened()) {
	    $obj_data->{message} = "Move leaves your king in check";
	    return 0;
	}
    }
    else {
	if ($valid_castle == MOVE_CASTLE_SHORT) {
	    my $tsq = Chess::Board->square_right_of($sq1);
    	    $clone->make_move($sq1, $tsq, 0);
	    _mark_threatened_kings($r_clone);
	    unless (!$king->threatened()) {
		$obj_data->{message} = "Can't castle through check";
		return 0;
	    }
	    $clone->make_move($tsq, $sq2, 0);
	    _mark_threatened_kings($r_clone);
	    unless (!$king->threatened()) {
		$obj_data->{message} = "Move leaves your king in check";
		return 0;
	    }
	}
	else {
	    my $tsq = Chess::Board->square_left_of($sq1);
	    $clone->make_move($sq1, $tsq, 0);
	    _mark_threatened_kings($r_clone);
	    unless (!$king->threatened()) {
		$obj_data->{message} = "Can't castle through check";
		return 0;
	    }
	    $clone->make_move($tsq, $sq2, 0);
	    _mark_threatened_kings($r_clone);
	    unless (!$king->threatened()) {
		$obj_data->{message} = "Move leaves your king in check";
		return 0;
	    }
	}
    }
    $obj_data->{message} = '';
    return 1;
}

sub make_move {
    my ($self, $sq1, $sq2, $validate) = @_;
    my $move;
    $validate = 1 unless (defined($validate));
    unless (Chess::Board->square_is_valid($sq1)) {
	carp "Invalid square '$sq1'";
	return undef;
    }
    unless (Chess::Board->square_is_valid($sq2)) {
	carp "Invalid square '$sq2'";
	return undef;
    }
    if ($validate) {