view release on metacpan or  search on metacpan

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

	$new_castling &= $castling_rights_rook_masks[$to];

	my $captured = ((($move) >> 3) & 0x7);

	# Remove captured piece.
	if ($captured) {
		if (((($move) >> 22) & 0x1)) {
			my $ep_shift = $self->[CP_POS_EN_PASSANT_SHIFT];
			my $capture_mask = $ep_pawn_masks[$ep_shift];
			$self->[$her_idx] ^= $capture_mask;
			$self->[CP_PAWN] ^= $capture_mask;
		} else {
			my $capture_mask = (1 << $to);
			$self->[$her_idx] ^= $capture_mask;
			$self->[$captured] ^= $capture_mask;
		}
	}

	if (CP_PAWN == $piece) {
		$self->[CP_POS_HALFMOVE_CLOCK] = 0;
		if ((!(($to - $from) & 0x9))) {
			$self->[CP_POS_EN_PASSANT_SHIFT] = $from + (($to - $from) >> 1);
		} else {
			$self->[CP_POS_EN_PASSANT_SHIFT] = 0;
		}
	} elsif ($captured) {
		$self->[CP_POS_EN_PASSANT_SHIFT] = 0;
		$self->[CP_POS_HALFMOVE_CLOCK] = 0;
	} else {
		$self->[CP_POS_EN_PASSANT_SHIFT] = 0;
		++$self->[CP_POS_HALFMOVE_CLOCK];
	}

	$self->[$my_idx] ^= $move_mask;
	$self->[$piece] ^= $move_mask;

	# It is better to overwrite the castling rights unconditionally because
	# it safes branches.  There is one edge case, where a pawn captures a
	# rook that is on its initial position.  In that case, the castling
	# rights may have to be updated.
	$self->[CP_POS_CASTLING_RIGHTS] = $new_castling;

	if ($promote) {
		$self->[CP_POS_PAWNS] ^= $to_mask;
		$self->[$promote] ^= $to_mask;
	}

	++$self->[CP_POS_HALFMOVES];
	$self->[CP_POS_TURN] = !$to_move;

	$self->[CP_POS_MATERIAL] += $material_deltas[$to_move | ($promote << 1) | ($captured << 4)];
	$self->[CP_POS_LAST_MOVE] = $move;
}

sub doMove {
	my ($self, $move) = @_;

	my @check_info = $self->inCheck;
	return if !$self->checkPseudoLegalMove($move, @check_info);

	my @backup = @$self;

	$self->move($move);

	return \@backup;
}

sub undoMove {
	my ($self, $backup) = @_;

	@$self = @$backup;
}

sub bMagic {
	my ($self, $shift, $occupancy) = @_;

	return CP_MAGICMOVESBDB->[$shift][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$shift]) * CP_MAGICMOVES_B_MAGICS->[$shift]) >> 55) & ((1 << (64 - 55)) - 1)];
}

sub rMagic {
	my ($self, $shift, $occupancy) = @_;

	return CP_MAGICMOVESRDB->[$shift][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$shift]) * CP_MAGICMOVES_R_MAGICS->[$shift]) >> 52) & ((1 << (64 - 52)) - 1)];
}

# Position info methods.
sub castlingRights {
	my ($self) = @_;

	return $self->[CP_POS_CASTLING_RIGHTS];
}

sub whiteKingSideCastlingRight {
	my ($self) = @_;

	return ($self->[CP_POS_CASTLING_RIGHTS] & 1);
}

sub whiteQueenSideCastlingRight {
	my ($self) = @_;

	return (($self->[CP_POS_CASTLING_RIGHTS] & 2));
}

sub blackKingSideCastlingRight {
	my ($self) = @_;

	return (($self->[CP_POS_CASTLING_RIGHTS] & 4));
}

sub blackQueenSideCastlingRight {
	my ($self) = @_;

	return ($self->[CP_POS_CASTLING_RIGHTS] & 8);
}

sub turn {
	my ($self) = @_;

	return $self->[CP_POS_TURN];
}

sub toMove {
	my ($self) = @_;

	return $self->[CP_POS_TURN];
}

sub enPassantShift {
	my ($self) = @_;

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

			pop @san;
		}

		# Leading garbage?
		if (@san) {
			require Carp;
			Carp::croak(__"Illegal SAN string: leading garbage found!\n");
		}

		$pattern = join '', $piece, 
				$from_file, $from_rank, $to_file, $to_rank, $promote;
	}

	# Get the legal moves.
	my @legal = $self->movesCoordinateNotation($self->legalMoves);

	# Prefix every move with the piece that moves.
	my @pieces = qw(X P N B R Q K);
	foreach my $move (@legal) {
		my $from_square = substr $move, 0, 2;
		my $mover = $self->pieceAtSquare($from_square);
		$move = $pieces[$mover] . $move;
	}

	my @candidates;
	@candidates = grep { /^$pattern$/ } @legal;

	# We must find exactly one candidate.  If we have 0 matches, the move
	# could not be parsed.  If we have more than 1 match, the move was
	# ambiguous.
	if (@candidates != 1 && $move !~ /^[PNBRQK]/) {
		# If no piece was explicitely specified, try again with a pawn.
		$pattern =~ s/^./P/;
		@candidates = grep { /^$pattern$/ } @legal;
	}

	if (!@candidates) {
		require Carp;
		Carp::croak(__"Illegal SAN string: illegal move.\n");
	} elsif (@candidates > 1) {
		require Carp;
		Carp::croak(__"Illegal SAN string: move is ambiguous.\n");
	}

	$move = $candidates[0];
	if ($move !~ /^[PNBRQK]([a-h][1-8])([a-h][1-8])([qrbn])?$/) {
		require Carp;
		Carp::croak(__"Illegal SAN string: syntax error.\n");
	}

	return $self->__parseUCIMove($1, $2, $3);
}

sub perft {
	my ($self, $depth) = @_;

	my $nodes = 0;

	my @check_info = $self->inCheck;
	my @moves = $self->pseudoLegalMoves;
	my @backup = @$self;
	foreach my $move (@moves) {
		next if !checkPseudoLegalMove($self, $move, @check_info);
		$self->move($move);

		if ($depth > 1) {
			$nodes += perft($self, $depth - 1);
		} else {
			++$nodes;
		}

		@$self = @backup;
	}

	return $nodes;
}

sub perftWithOutput {
	my ($self, $depth, $fh) = @_;

	return if $depth <= 0;

	require Time::HiRes;
	my $started = [Time::HiRes::gettimeofday()];

	my $nodes = 0;

	my @check_info = $self->inCheck;
	my @moves = $self->pseudoLegalMoves;
	my @backup = @$self;
	foreach my $move (@moves) {
		next if !$self->checkPseudoLegalMove($move, @check_info);
		my $movestr = $self->moveCoordinateNotation($move);
		$fh->print("$movestr: ");

		$self->move($move);

		my $subnodes;
		if ($depth > 1) {
			$subnodes = $self->perft($depth - 1);
		} else {
			$subnodes = 1;
		}

		$nodes += $subnodes;
		$fh->print("$subnodes\n");

		@$self = @backup;
	}

	no integer;

	my $elapsed = Time::HiRes::tv_interval($started, [Time::HiRes::gettimeofday()]);

	my $nps = '+INF';
	if ($elapsed) {
		$nps = int (0.5 + $nodes / $elapsed);
	}
	$fh->print("info nodes: $nodes ($elapsed s, nps: $nps)\n");

	return $nodes;
}

sub coordinatesToShift {
	my (undef, $file, $rank) = @_;

	return ($rank << 3) + $file;
}

sub coordinatesToSquare {
	my (undef, $file, $rank) = @_;

	return chr(97 + $file) . (1 + $rank);
}

sub shiftToCoordinates {
	my (undef, $shift) = @_;

	my $file = $shift & 0x7;
	my $rank = $shift >> 3;

	return $file, $rank;
}

sub squareToCoordinates {
	my (undef, $square) = @_;

	return ord($square) - 97, -1 + substr $square, 1;
}

sub shiftToSquare {
	my (undef, $shift) = @_;

	my $rank = 1 + ($shift >> 3);
	my $file = $shift & 0x7;

	return sprintf '%c%u', $file + ord 'a', $rank;
}

sub squareToShift {
	my ($whatever, $square) = @_;

	if ($square !~ /^([a-h])([1-8])$/) {
		die __x("Illegal square '{square}'.\n", square => $square);
	}

	my $file = ord($1) - ord('a');
	my $rank = $2 - 1;