pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpchess: Patch from Brian Chalega da Silva, improves the bishop moves

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1562 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-04-11 05:46:27 +00:00
parent 5cbd0741f8
commit 7060f8080c
1 changed files with 45 additions and 150 deletions
Download Patch File Download Diff File Expand all files Collapse all files

195
applications/fpchess/chessgame.pas
View File

@@ -321,166 +321,61 @@ end;
function TChessGame.ValidateBishopMove(AFrom, ATo: TPoint): Boolean; function TChessGame.ValidateBishopMove(AFrom, ATo: TPoint): Boolean;
var var
AttackedSquares : BitBoard;
i,j : Integer; i,j : Integer;
x,y : integer;
haveCaptured: boolean = false; //already have captured a piece
willBeACapture : boolean = false;// the movement will be a capture
validMove : boolean = false; //if the piece in the 'to' square is not of the same color of the player
mensagem : String;
begin begin
for i:=1 to 8 do // initialize the bitboard of attacked pieces. result :=false;
for j:=1 to 8 do //Up left
AttackedSquares[i][j]:= false; if (AFrom.X>ATo.X) and (AFrom.Y<ATo.Y) and (AFrom.X-ATo.X=ATo.Y-AFrom.Y)then
//////////////////////////////////////UP LEFT/////////////////////////////////// begin
y := AFrom.y+1; i := AFrom.X-1;
x := AFrom.x-1; j := AFrom.Y+1;
if (x>=1) and (y<=8) then begin while (i>=ATo.X+1) and (j<=ATo.Y-1) do
if (CurrentPlayerIsWhite) then begin begin
willBeACapture:= (Board[x][y] in BlackPieces); if Board[i][j] <> ctEmpty then Exit;
validMove:= not (Board[x][y] in WhitePieces); i := i - 1;
end j := j + 1;
else begin
willBeACapture:=(Board[x][y] in WhitePieces);
validMove:=not (Board[x][y] in BlackPieces)
end;
end
else
y :=0; // if it is in the border of the board, put 0 in l to skip the while below.
haveCaptured:=false;
while ( (x>=1) and (y <= 8) and (validMove) and (not haveCaptured)) do begin
AttackedSquares[x][y] := true;
if (willBeACapture) then
haveCaptured:=true;
y := y+1;
x := x-1;
if (x>=1) and (y<=8) then begin //again to not have an 'out of bounds' error
if (CurrentPlayerIsWhite) then begin
willBeACapture:= (Board[x][y] in BlackPieces);
validMove:= not (Board[x][y] in WhitePieces);
end
else begin
willBeACapture:=(Board[x][y] in WhitePieces);
validMove:=not (Board[x][y] in BlackPieces)
end;
end; end;
exit(True);
end; end;
///////////////////////////////////END UP LEFT////////////////////////////////// //Up right
if (AFrom.X<ATo.X) and (AFrom.Y<ATo.Y) and (ATo.X-AFrom.X=ATo.Y-AFrom.Y) then
//////////////////////////////////////UP RIGHT////////////////////////////////// begin
y := AFrom.y+1; i := AFrom.X+1;
x := AFrom.x+1; j := AFrom.Y+1;
willBeACapture:=false; while (i<=ATo.X-1) and (j<=ATo.Y-1) do
if (x<=8) and (y<=8) then begin begin
if (CurrentPlayerIsWhite) then begin if Board[i][j] <> ctEmpty then Exit;
willBeACapture:= (Board[x][y] in BlackPieces); i := i + 1;
validMove:= not (Board[x][y] in WhitePieces); j := j + 1;
end
else begin
willBeACapture:=(Board[x][y] in WhitePieces);
validMove:=not (Board[x][y] in BlackPieces)
end;
end
else
y :=0; // if it is in the border of the board, put 0 in l to skip the while below.
haveCaptured:=false;
while ( (x<=8) and (y <= 8) and (validMove) and (not haveCaptured)) do begin
AttackedSquares[x][y] := true;
if (willBeACapture) then
haveCaptured:=true;
y := y+1;
x := x+1;
if (x<=8) and (y<=8) then begin //again to not have an 'out of bounds' error
if (CurrentPlayerIsWhite) then begin
willBeACapture:= (Board[x][y] in BlackPieces);
validMove:= not (Board[x][y] in WhitePieces);
end
else begin
willBeACapture:=(Board[x][y] in WhitePieces);
validMove:=not (Board[x][y] in BlackPieces)
end;
end; end;
exit(True);
end; end;
///////////////////////////////////END UP RIGHT///////////////////////////////// //Down left
//////////////////////////////////////DOWN LEFT///////////////////////////////// if (AFrom.X>ATo.X) and (AFrom.Y>ATo.Y) and (AFrom.X-ATo.X=AFrom.Y-ATo.Y) then
y := AFrom.y-1; begin
x := AFrom.x-1; i := AFrom.X-1;
willBeACapture:=false; j := AFrom.Y-1;
if (x>=1) and (y>=1) then begin while (i>=ATo.X+1) and (j>=ATo.Y+1) do
if (CurrentPlayerIsWhite) then begin begin
willBeACapture:= (Board[x][y] in BlackPieces); if Board[i][j] <> ctEmpty then Exit;
validMove:= not (Board[x][y] in WhitePieces); i := i - 1;
end j := j - 1;
else begin
willBeACapture:=(Board[x][y] in WhitePieces);
validMove:=not (Board[x][y] in BlackPieces)
end;
end
else
y :=0; // if it is in the border of the board, put 0 in l to skip the while below.
haveCaptured:=false;
while ( (x>=1) and (y >= 1) and (validMove) and (not haveCaptured)) do begin
AttackedSquares[x][y] := true;
if (willBeACapture) then
haveCaptured:=true;
y := y-1;
x := x-1;
if (x>=1) and (y>=1) then begin //again to not have an 'out of bounds' error
if (CurrentPlayerIsWhite) then begin
willBeACapture:= (Board[x][y] in BlackPieces);
validMove:= not (Board[x][y] in WhitePieces);
end
else begin
willBeACapture:=(Board[x][y] in WhitePieces);
validMove:=not (Board[x][y] in BlackPieces)
end;
end; end;
exit(True);
end; end;
///////////////////////////////////END DOWN LEFT//////////////////////////////// //Down right
//////////////////////////////////////DOWN RIGHT//////////////////////////////// if (AFrom.X<ATo.X) and (AFrom.Y>ATo.Y) and (ATo.X-AFrom.X=AFrom.Y-ATo.Y)then
y := AFrom.y-1; begin
x := AFrom.x+1; i := AFrom.X+1;
willBeACapture:=false; j := AFrom.Y-1;
if (x<=8) and (y>=1) then begin while (i<=ATo.X-1) and (j>=ATo.Y+1) do
if (CurrentPlayerIsWhite) then begin begin
willBeACapture:= (Board[x][y] in BlackPieces); if Board[i][j] <> ctEmpty then Exit;
validMove:= not (Board[x][y] in WhitePieces); i := i + 1;
end j := j - 1;
else begin
willBeACapture:=(Board[x][y] in WhitePieces);
validMove:=not (Board[x][y] in BlackPieces)
end;
end
else
y :=0; // if it is in the border of the board, put 0 in l to skip the while below.
haveCaptured:=false;
while ( (x<=8) and (y >= 1) and (validMove) and (not haveCaptured)) do begin
AttackedSquares[x][y] := true;
if (willBeACapture) then
haveCaptured:=true;
y := y-1;
x := x+1;
if (x<=8) and (y>=1) then begin //again to not have an 'out of bounds' error
if (CurrentPlayerIsWhite) then begin
willBeACapture:= (Board[x][y] in BlackPieces);
validMove:= not (Board[x][y] in WhitePieces);
end
else begin
willBeACapture:=(Board[x][y] in WhitePieces);
validMove:=not (Board[x][y] in BlackPieces)
end;
end; end;
exit(True);
end; end;
///////////////////////////////////END DOWN RIGHT///////////////////////////////
{for i:=1 to 8 do begin //To show the bitboard
for j:=1 to 8 do
mensagem := mensagem + BoolToStr(AttackedSquares[i][j],'1','0') + ' ';
mensagem := mensagem + #13;
end;
ShowMessage(mensagem);}
result := (AttackedSquares[Ato.X][Ato.y]);
end; end;
function TChessGame.ValidateQueenMove(AFrom, ATo: TPoint): Boolean; function TChessGame.ValidateQueenMove(AFrom, ATo: TPoint): Boolean;