diff --git a/applications/fpchess/chessgame.pas b/applications/fpchess/chessgame.pas index 9cedb4bd4..a427053e9 100644 --- a/applications/fpchess/chessgame.pas +++ b/applications/fpchess/chessgame.pas @@ -5,7 +5,9 @@ unit chessgame; interface uses - Classes, SysUtils, fpimage, dateutils; + Classes, SysUtils, fpimage, dateutils, + Forms, Controls, Graphics, Dialogs, + ExtCtrls, ComCtrls, StdCtrls, Buttons, Spin; const colA = 1; @@ -25,6 +27,7 @@ const type TPacketKind = (pkConnect, pkStartGameClientAsWhite, pkStartGameClientAsBlack, pkMove); + BitBoard = array[1..8] of array [1..8] of boolean; { TPacket } @@ -60,6 +63,7 @@ type TChessGame = class public Board: TChessBoard; + msg : String; CurrentPlayerIsWhite: Boolean; Dragging: Boolean; DragStart, MouseMovePos: TPoint; @@ -73,6 +77,13 @@ type function ClientToBoardCoords(AClientCoords: TPoint): TPoint; function CheckStartMove(AFrom: TPoint): Boolean; function MovePiece(AFrom, ATo: TPoint): Boolean; + function ValidateRookMove(AFrom, ATo: TPoint) : boolean; + function ValidateKnightMove(AFrom, ATo: TPoint) : boolean; + function ValidateBishopMove(AFrom, ATo: TPoint) : boolean; + function ValidateQueenMove(AFrom, ATo: TPoint) : boolean; + function ValidateKingMove(AFrom, ATo: TPoint) : boolean; + function ValidatePawnMove(AFrom, ATo: TPoint) : boolean; + procedure UpdateTimes(); end; @@ -162,21 +173,671 @@ end; } function TChessGame.MovePiece(AFrom, ATo: TPoint): Boolean; begin - Result := False; + result := false; + //AFrom.x:=AFrom.x; + //AFrom.y:=AFrom.y+2; + //if not CheckStartMove(AFrom) then Exit; - if not CheckStartMove(AFrom) then Exit; + if ( (Board[AFrom.X][AFrom.Y]) in WhitePieces ) then begin + if Board[AFrom.X][AFrom.Y] = ctWRook then result:=(ValidateRookMove(AFrom,ATo));; + if Board[AFrom.X][AFrom.Y] = ctWKnight then result :=(ValidateKnightMove(AFrom,ATo)); + if Board[AFrom.X][AFrom.Y] = ctWBishop then result :=(ValidateBishopMove(AFrom,ATo)); + if Board[AFrom.X][AFrom.Y] = ctWQueen then result :=(ValidateQueenMove(AFrom,ATo)); + if Board[AFrom.X][AFrom.Y] = ctWKing then result :=(ValidateKingMove(AFrom,ATo)); + if Board[AFrom.X][AFrom.Y] = ctWPawn then result :=(ValidatePawnMove(AFrom,ATo)); + end + else begin + if Board[AFrom.X][AFrom.Y] = ctBRook then result :=(ValidateRookMove(AFrom,ATo)); + if Board[AFrom.X][AFrom.Y] = ctBKnight then result :=(ValidateKnightMove(AFrom,ATo)); + if Board[AFrom.X][AFrom.Y] = ctBBishop then result :=(ValidateBishopMove(AFrom,ATo)); + if Board[AFrom.X][AFrom.Y] = ctBQueen then result :=(ValidateQueenMove(AFrom,ATo)); + if Board[AFrom.X][AFrom.Y] = ctBKing then result :=(ValidateKingMove(AFrom,ATo)); + if Board[AFrom.X][AFrom.Y] = ctBPawn then result :=(ValidatePawnMove(AFrom,ATo)); + end; +// ShowMessage('Resultado := ' + BoolToStr(result,true)); + if (result) then begin + // col, row + Board[ATo.X][ATo.Y] := Board[AFrom.X][AFrom.Y]; + Board[AFrom.X][AFrom.Y] := ctEmpty; - // Parameter checking - if (AFrom.X < 1) or (AFrom.X > 8) or (ATo.X < 1) or (ATo.X > 8) then Exit; - if (AFrom.Y < 1) or (AFrom.Y > 8) or (ATo.Y < 1) or (ATo.Y > 8) then Exit; + UpdateTimes(); + CurrentPlayerIsWhite := not CurrentPlayerIsWhite; + end; +end; - // col, row - Board[ATo.X][ATo.Y] := Board[AFrom.X][AFrom.Y]; - Board[AFrom.X][AFrom.Y] := ctEmpty; +//return true if the move of a Rook is valid. +function TChessGame.ValidateRookMove(AFrom, ATo: TPoint): boolean; +var AttackedSquares : BitBoard; + i,j : Integer; + l : integer = 0; + 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 - UpdateTimes(); - CurrentPlayerIsWhite := not CurrentPlayerIsWhite; + for i:=1 to 8 do // initialize the bitboard of attacked pieces. + for j:=1 to 8 do + AttackedSquares[i][j]:= false; +// ShowMessage('vai passar pelo up'); +//////////////////////////////////////UP//////////////////////////////////////// + l := AFrom.y+1; + if (l<=8) then begin + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[AFrom.x][l] in BlackPieces); + validMove:= not (Board[AFrom.x][l] in WhitePieces); + end + else begin + willBeACapture:=(Board[AFrom.x][l] in WhitePieces); + validMove:=not (Board[AFrom.x][l] in BlackPieces) + end; + end + else + l :=0; // if it is in the border of the board, put 0 in l to skip the while below. + haveCaptured:=false; + while ( (l <= 8) and (validMove) and (not haveCaptured)) do begin + AttackedSquares[AFrom.x][l] := true; + if (willBeACapture) then + haveCaptured:=true; + l := l+1; + if (l<=8) then begin //again to not have an 'out of bounds' error + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[AFrom.x][l] in BlackPieces); + validMove:= not (Board[AFrom.x][l] in WhitePieces); + end + else begin + willBeACapture:=(Board[AFrom.x][l] in WhitePieces); + validMove:=not (Board[AFrom.x][l] in BlackPieces) + end; + end; + end; +///////////////////////////////////END UP/////////////////////////////////////// +///////////////////////////////////DOWN///////////////////////////////////////// + haveCaptured:=false; + l := AFrom.y-1; + if (l>=1) then begin + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[AFrom.x][l] in BlackPieces); + validMove:= not (Board[AFrom.x][l] in WhitePieces); + end + else begin + willBeACapture:=(Board[AFrom.x][l] in WhitePieces); + validMove:=not (Board[AFrom.x][l] in BlackPieces) + end; + end + else + l :=0; // if it is in the border of the board, put 0 in l to skip the while below. + haveCaptured:=false; + while ( (l >= 1) and (validMove) and (not haveCaptured)) do begin + AttackedSquares[AFrom.x][l] := true; + if (willBeACapture) then + haveCaptured:=true; + l := l-1; + if (l>=1) then begin //again to not have an 'out of bounds' error + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[AFrom.x][l] in BlackPieces); + validMove:= not (Board[AFrom.x][l] in WhitePieces); + end + else begin + willBeACapture:=(Board[AFrom.x][l] in WhitePieces); + validMove:=not (Board[AFrom.x][l] in BlackPieces) + end; + end; + end; +///////////////////////////////////END DOWN///////////////////////////////////// +////////////////////////////////////RIGHT//////////////////////////////////////// + haveCaptured:=false; + l := AFrom.x+1; + if (l<=8) then begin + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[l][AFrom.y] in BlackPieces); + validMove:= not (Board[l][AFrom.y] in WhitePieces); + end + else begin + willBeACapture:=(Board[l][AFrom.y] in WhitePieces); + validMove:=not (Board[l][AFrom.y] in BlackPieces) + end; + end + else + l :=0; // if it is in the border of the board, put 0 in l to skip the while below. + haveCaptured:=false; + while ( (l <= 8) and (validMove) and (not haveCaptured)) do begin + AttackedSquares[l][AFrom.y] := true; + if (willBeACapture) then + haveCaptured:=true; + l := l+1; + if (l<=8) then begin //again to not have an 'out of bounds' error + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[l][AFrom.y] in BlackPieces); + validMove:= not (Board[l][AFrom.y] in WhitePieces); + end + else begin + willBeACapture:=(Board[l][AFrom.y] in WhitePieces); + validMove:=not (Board[l][AFrom.y] in BlackPieces) + end; + end; + end; +///////////////////////////////////END RIGHT//////////////////////////////////// +///////////////////////////////////LEFT///////////////////////////////////////// + haveCaptured:=false; + l := AFrom.x-1; + if (l>=1) then begin + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[l][AFrom.y] in BlackPieces); + validMove:= not (Board[l][AFrom.y] in WhitePieces); + end + else begin + willBeACapture:=(Board[l][AFrom.y] in WhitePieces); + validMove:=not (Board[l][AFrom.y] in BlackPieces) + end; + end + else + l :=0; // if it is in the border of the board, put 0 in l to skip the while below. + haveCaptured:=false; + while ( (l >= 1) and (validMove) and (not haveCaptured)) do begin + AttackedSquares[l][AFrom.y] := true; + if (willBeACapture) then + haveCaptured:=true; + l := l-1; + if (l>=1) then begin //again to not have an 'out of bounds' error + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[l][AFrom.y] in BlackPieces); + validMove:= not (Board[l][AFrom.y] in WhitePieces); + end + else begin + willBeACapture:=(Board[l][AFrom.y] in WhitePieces); + validMove:=not (Board[l][AFrom.y] in BlackPieces) + end; + end; + end; +///////////////////////////////////END LEFT///////////////////////////////////// + + +{ 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:=true; + result := (AttackedSquares[Ato.X][Ato.y]); +end; +function TChessGame.ValidateKnightMove(AFrom, ATo: TPoint): Boolean; +begin +result:=true; +end; +function TChessGame.ValidateBishopMove(AFrom, ATo: TPoint): Boolean; +var AttackedSquares : BitBoard; + 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 + for i:=1 to 8 do // initialize the bitboard of attacked pieces. + for j:=1 to 8 do + AttackedSquares[i][j]:= false; +// ShowMessage('vai passar pelo up left'); +//////////////////////////////////////UP LEFT/////////////////////////////////// + y := AFrom.y+1; + x := AFrom.x-1; + if (x>=1) and (y<=8) then begin + 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 + 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; +///////////////////////////////////END UP LEFT////////////////////////////////// + +//////////////////////////////////////UP RIGHT////////////////////////////////// + y := AFrom.y+1; + x := AFrom.x+1; + willBeACapture:=false; + if (x<=8) and (y<=8) then begin + 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 + 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; +///////////////////////////////////END UP RIGHT///////////////////////////////// +//////////////////////////////////////DOWN LEFT///////////////////////////////// + y := AFrom.y-1; + x := AFrom.x-1; + willBeACapture:=false; + if (x>=1) and (y>=1) then begin + 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 + 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; +///////////////////////////////////END DOWN LEFT//////////////////////////////// +//////////////////////////////////////DOWN RIGHT//////////////////////////////// + y := AFrom.y-1; + x := AFrom.x+1; + willBeACapture:=false; + if (x<=8) and (y>=1) then begin + 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 + 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; +///////////////////////////////////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; +function TChessGame.ValidateQueenMove(AFrom, ATo: TPoint): Boolean; +var AttackedSquares : BitBoard; + i,j : Integer; + x,y,l : integer; //l it's the same of the y or x, just an index. + 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 + + for i:=1 to 8 do // initialize the bitboard of attacked pieces. + for j:=1 to 8 do + AttackedSquares[i][j]:= false; +// ShowMessage('vai passar pelo up'); + +//////////////////////////////////////UP//////////////////////////////////////// + l := AFrom.y+1; + if (l<=8) then begin + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[AFrom.x][l] in BlackPieces); + validMove:= not (Board[AFrom.x][l] in WhitePieces); + end + else begin + willBeACapture:=(Board[AFrom.x][l] in WhitePieces); + validMove:=not (Board[AFrom.x][l] in BlackPieces) + end; + end + else + l :=0; // if it is in the border of the board, put 0 in l to skip the while below. + haveCaptured:=false; + while ( (l <= 8) and (validMove) and (not haveCaptured)) do begin + AttackedSquares[AFrom.x][l] := true; + if (willBeACapture) then + haveCaptured:=true; + l := l+1; + if (l<=8) then begin //again to not have an 'out of bounds' error + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[AFrom.x][l] in BlackPieces); + validMove:= not (Board[AFrom.x][l] in WhitePieces); + end + else begin + willBeACapture:=(Board[AFrom.x][l] in WhitePieces); + validMove:=not (Board[AFrom.x][l] in BlackPieces) + end; + end; + end; +///////////////////////////////////END UP/////////////////////////////////////// +///////////////////////////////////DOWN///////////////////////////////////////// + haveCaptured:=false; + l := AFrom.y-1; + if (l>=1) then begin + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[AFrom.x][l] in BlackPieces); + validMove:= not (Board[AFrom.x][l] in WhitePieces); + end + else begin + willBeACapture:=(Board[AFrom.x][l] in WhitePieces); + validMove:=not (Board[AFrom.x][l] in BlackPieces) + end; + end + else + l :=0; // if it is in the border of the board, put 0 in l to skip the while below. + haveCaptured:=false; + while ( (l >= 1) and (validMove) and (not haveCaptured)) do begin + AttackedSquares[AFrom.x][l] := true; + if (willBeACapture) then + haveCaptured:=true; + l := l-1; + if (l>=1) then begin //again to not have an 'out of bounds' error + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[AFrom.x][l] in BlackPieces); + validMove:= not (Board[AFrom.x][l] in WhitePieces); + end + else begin + willBeACapture:=(Board[AFrom.x][l] in WhitePieces); + validMove:=not (Board[AFrom.x][l] in BlackPieces) + end; + end; + end; +///////////////////////////////////DOWN///////////////////////////////////////// + +////////////////////////////////////RIGHT//////////////////////////////////////// + haveCaptured:=false; + l := AFrom.x+1; + if (l<=8) then begin + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[l][AFrom.y] in BlackPieces); + validMove:= not (Board[l][AFrom.y] in WhitePieces); + end + else begin + willBeACapture:=(Board[l][AFrom.y] in WhitePieces); + validMove:=not (Board[l][AFrom.y] in BlackPieces) + end; + end + else + l :=0; // if it is in the border of the board, put 0 in l to skip the while below. + haveCaptured:=false; + while ( (l <= 8) and (validMove) and (not haveCaptured)) do begin + AttackedSquares[l][AFrom.y] := true; + if (willBeACapture) then + haveCaptured:=true; + l := l+1; + if (l<=8) then begin //again to not have an 'out of bounds' error + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[l][AFrom.y] in BlackPieces); + validMove:= not (Board[l][AFrom.y] in WhitePieces); + end + else begin + willBeACapture:=(Board[l][AFrom.y] in WhitePieces); + validMove:=not (Board[l][AFrom.y] in BlackPieces) + end; + end; + end; +///////////////////////////////////END RIGHT//////////////////////////////////// +///////////////////////////////////LEFT///////////////////////////////////////// + haveCaptured:=false; + l := AFrom.x-1; + if (l>=1) then begin + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[l][AFrom.y] in BlackPieces); + validMove:= not (Board[l][AFrom.y] in WhitePieces); + end + else begin + willBeACapture:=(Board[l][AFrom.y] in WhitePieces); + validMove:=not (Board[l][AFrom.y] in BlackPieces) + end; + end + else + l :=0; // if it is in the border of the board, put 0 in l to skip the while below. + haveCaptured:=false; + while ( (l >= 1) and (validMove) and (not haveCaptured)) do begin + AttackedSquares[l][AFrom.y] := true; + if (willBeACapture) then + haveCaptured:=true; + l := l-1; + if (l>=1) then begin //again to not have an 'out of bounds' error + if (CurrentPlayerIsWhite) then begin + willBeACapture:= (Board[l][AFrom.y] in BlackPieces); + validMove:= not (Board[l][AFrom.y] in WhitePieces); + end + else begin + willBeACapture:=(Board[l][AFrom.y] in WhitePieces); + validMove:=not (Board[l][AFrom.y] in BlackPieces) + end; + end; + end; +///////////////////////////////////END LEFT///////////////////////////////////// +//////////////////////////////////////UP LEFT/////////////////////////////////// + y := AFrom.y+1; + x := AFrom.x-1; + if (x>=1) and (y<=8) then begin + 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 + 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; +///////////////////////////////////END UP LEFT////////////////////////////////// + +//////////////////////////////////////UP RIGHT////////////////////////////////// + y := AFrom.y+1; + x := AFrom.x+1; + willBeACapture:=false; + if (x<=8) and (y<=8) then begin + 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 + 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; +///////////////////////////////////END UP RIGHT///////////////////////////////// +//////////////////////////////////////DOWN LEFT///////////////////////////////// + y := AFrom.y-1; + x := AFrom.x-1; + willBeACapture:=false; + if (x>=1) and (y>=1) then begin + 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 + 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; +///////////////////////////////////END DOWN LEFT//////////////////////////////// +//////////////////////////////////////DOWN RIGHT//////////////////////////////// + y := AFrom.y-1; + x := AFrom.x+1; + willBeACapture:=false; + if (x<=8) and (y>=1) then begin + 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 + 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; +///////////////////////////////////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; + +function TChessGame.ValidateKingMove(AFrom, ATo: TPoint): Boolean; +begin + Result := True; +end; + +function TChessGame.ValidatePawnMove(AFrom, ATo: TPoint): Boolean; +begin Result := True; end; diff --git a/applications/fpchess/chesstcputils.pas b/applications/fpchess/chesstcputils.pas index 2fe767f33..56c63246b 100644 --- a/applications/fpchess/chesstcputils.pas +++ b/applications/fpchess/chesstcputils.pas @@ -8,7 +8,7 @@ uses {$IFDEF MSWINDOWS} Winsock, {$ENDIF} - Classes, SysUtils; + Classes, SysUtils, Process; function ChessGetLocalIP(): string; diff --git a/applications/fpchess/fpchess.lpi b/applications/fpchess/fpchess.lpi index 75b0fcdb7..710219b0d 100644 --- a/applications/fpchess/fpchess.lpi +++ b/applications/fpchess/fpchess.lpi @@ -16,6 +16,9 @@ + + + @@ -24,6 +27,7 @@ + @@ -70,7 +74,7 @@ - + diff --git a/applications/fpchess/fpchess.lpr b/applications/fpchess/fpchess.lpr index 748c64ecc..3c0d5b90c 100644 --- a/applications/fpchess/fpchess.lpr +++ b/applications/fpchess/fpchess.lpr @@ -10,7 +10,7 @@ uses Forms, lnetvisual, mainform, chessdrawer, chessgame, chessconfig, chesstcputils; -{$R *.res} +//{$R *.res} begin Application.Initialize; diff --git a/applications/fpchess/mainform.lfm b/applications/fpchess/mainform.lfm index 53e94cc09..9492557a9 100644 --- a/applications/fpchess/mainform.lfm +++ b/applications/fpchess/mainform.lfm @@ -3,22 +3,22 @@ object formChess: TformChess Height = 433 Top = 209 Width = 360 + ActiveControl = notebookMain Caption = 'FP Chess 0.1' ClientHeight = 433 ClientWidth = 360 OnCreate = FormCreate - LCLVersion = '0.9.29' - object notebookMain: TUntabbedNotebook + LCLVersion = '0.9.31' + object notebookMain: TNotebook Left = 0 Height = 433 Top = 0 Width = 360 - PageIndex = 4 + PageIndex = 0 Align = alClient TabOrder = 0 TabStop = True - object pageStart: TUNBPage - OnBeforeShow = pageBeforeShow + object pageStart: TPage ClientWidth = 360 ClientHeight = 433 object Label1: TLabel @@ -43,37 +43,53 @@ object formChess: TformChess ParentColor = False WordWrap = True end + object Label6: TLabel + Left = 28 + Height = 18 + Top = 104 + Width = 56 + Caption = 'Start as:' + ParentColor = False + end + object Label7: TLabel + Left = 80 + Height = 18 + Top = 163 + Width = 152 + Caption = 'minutes for each player' + ParentColor = False + end object btnSinglePlayer: TBitBtn - Left = 64 + Left = 24 Height = 30 Top = 200 - Width = 224 + Width = 304 Caption = 'Play Against the Computer' Enabled = False OnClick = HandleMainScreenButton TabOrder = 0 end object btnDirectComm: TBitBtn - Left = 64 + Left = 24 Height = 30 - Top = 288 - Width = 224 + Top = 280 + Width = 304 Caption = 'Play with a friend through a direct connection' Enabled = False OnClick = HandleMainScreenButton TabOrder = 1 end object BitBtn3: TBitBtn - Left = 62 + Left = 24 Height = 30 - Top = 376 - Width = 224 + Top = 360 + Width = 304 Caption = 'Quit' TabOrder = 2 end object editPlayerName: TLabeledEdit Left = 88 - Height = 21 + Height = 25 Top = 72 Width = 120 EditLabel.AnchorSideLeft.Control = editPlayerName @@ -81,29 +97,21 @@ object formChess: TformChess EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = editPlayerName EditLabel.AnchorSideBottom.Control = editPlayerName - EditLabel.Left = 24 - EditLabel.Height = 14 + EditLabel.Left = 2 + EditLabel.Height = 18 EditLabel.Top = 75 - EditLabel.Width = 61 + EditLabel.Width = 83 EditLabel.Caption = 'Player Name' EditLabel.ParentColor = False LabelPosition = lpLeft TabOrder = 3 end - object Label6: TLabel - Left = 28 - Height = 14 - Top = 104 - Width = 43 - Caption = 'Start as:' - ParentColor = False - end object comboStartColor: TComboBox Left = 88 - Height = 21 + Height = 27 Top = 104 Width = 120 - ItemHeight = 13 + ItemHeight = 0 ItemIndex = 0 Items.Strings = ( 'White' @@ -114,9 +122,9 @@ object formChess: TformChess end object checkTimer: TCheckBox Left = 24 - Height = 17 + Height = 21 Top = 136 - Width = 163 + Width = 220 Caption = 'Set a time limit for each Player' Checked = True State = cbChecked @@ -124,43 +132,34 @@ object formChess: TformChess end object spinPlayerTime: TSpinEdit Left = 21 - Height = 21 + Height = 25 Top = 160 Width = 50 TabOrder = 6 Value = 30 end - object Label7: TLabel - Left = 80 - Height = 14 - Top = 163 - Width = 114 - Caption = 'minutes for each player' - ParentColor = False - end object btnHotSeat: TBitBtn - Left = 64 + Left = 24 Height = 30 Top = 240 - Width = 224 + Width = 304 Caption = 'Play with a friend in the same Computer' OnClick = HandleMainScreenButton TabOrder = 7 end object btnWebservice: TBitBtn - Left = 64 + Left = 24 Height = 30 - Top = 328 - Width = 224 + Top = 320 + Width = 304 Caption = 'Play with a friend through the chess Webservice' OnClick = HandleMainScreenButton TabOrder = 8 end end - object pageConfigConnection: TUNBPage - OnBeforeShow = pageBeforeShow - ClientWidth = 360 - ClientHeight = 433 + object pageConfigConnection: TPage + ClientWidth = 712 + ClientHeight = 810 object Label3: TLabel Left = 0 Height = 32 @@ -222,10 +221,9 @@ object formChess: TformChess TabOrder = 2 end end - object pageConnecting: TUNBPage - OnBeforeShow = pageBeforeShow - ClientWidth = 360 - ClientHeight = 433 + object pageConnecting: TPage + ClientWidth = 712 + ClientHeight = 810 object Label4: TLabel Left = 0 Height = 32 @@ -246,10 +244,9 @@ object formChess: TformChess TabOrder = 0 end end - object pageGame: TUNBPage - OnBeforeShow = pageBeforeShow - ClientWidth = 360 - ClientHeight = 433 + object pageGame: TPage + ClientWidth = 712 + ClientHeight = 810 object Label5: TLabel Left = 0 Height = 32 @@ -271,29 +268,9 @@ object formChess: TformChess ParentColor = False end end - object pageWebservice: TUNBPage - ClientWidth = 360 - ClientHeight = 433 - object editWebserviceURL: TLabeledEdit - Left = 72 - Height = 21 - Top = 72 - Width = 280 - EditLabel.AnchorSideLeft.Control = editPlayerName - EditLabel.AnchorSideTop.Control = editPlayerName - EditLabel.AnchorSideTop.Side = asrCenter - EditLabel.AnchorSideRight.Control = editPlayerName - EditLabel.AnchorSideBottom.Control = editPlayerName - EditLabel.Left = 24 - EditLabel.Height = 14 - EditLabel.Top = 75 - EditLabel.Width = 61 - EditLabel.Caption = 'Player Name' - EditLabel.ParentColor = False - LabelPosition = lpLeft - TabOrder = 0 - Text = 'http://www.bobswart.nl/cgi-bin/ChessISAPIServer.dll/wsdl/IDelphiChess' - end + object pageWebservice: TPage + ClientWidth = 712 + ClientHeight = 810 object Label8: TLabel Left = 0 Height = 32 @@ -306,6 +283,26 @@ object formChess: TformChess ParentColor = False ParentFont = False end + object editWebserviceURL: TLabeledEdit + Left = 72 + Height = 22 + Top = 72 + Width = 280 + EditLabel.AnchorSideLeft.Control = editPlayerName + EditLabel.AnchorSideTop.Control = editPlayerName + EditLabel.AnchorSideTop.Side = asrCenter + EditLabel.AnchorSideRight.Control = editPlayerName + EditLabel.AnchorSideBottom.Control = editPlayerName + EditLabel.Left = 6 + EditLabel.Height = 15 + EditLabel.Top = 75 + EditLabel.Width = 75 + EditLabel.Caption = 'Player Name' + EditLabel.ParentColor = False + LabelPosition = lpLeft + TabOrder = 0 + Text = 'http://www.bobswart.nl/cgi-bin/ChessISAPIServer.dll/wsdl/IDelphiChess' + end object Button1: TButton Left = 35 Height = 25 diff --git a/applications/fpchess/mainform.pas b/applications/fpchess/mainform.pas index 241b3407b..d17ab1fad 100644 --- a/applications/fpchess/mainform.pas +++ b/applications/fpchess/mainform.pas @@ -48,19 +48,19 @@ type editRemoteID: TLabeledEdit; editLocalIP: TLabeledEdit; editPlayerName: TLabeledEdit; - pageStart: TUNBPage; - pageConfigConnection: TUNBPage; - notebookMain: TUntabbedNotebook; - pageConnecting: TUNBPage; + pageStart: TPage; + pageConfigConnection: TPage; + notebookMain: TNotebook; + pageConnecting: TPage; ProgressBar1: TProgressBar; - pageGame: TUNBPage; + pageGame: TPage; spinPlayerTime: TSpinEdit; timerChessTimer: TTimer; - pageWebservice: TUNBPage; + pageWebservice: TPage; procedure btnConnectClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure HandleMainScreenButton(Sender: TObject); - procedure pageBeforeShow(Sender: TObject; ANewPage: TUNBPage; ANewIndex: Integer); + procedure pageBeforeShow(Sender: TObject; ANewPage: TPage; ANewIndex: Integer); procedure timerChessTimerTimer(Sender: TObject); private { private declarations } @@ -100,7 +100,7 @@ begin else if Sender = btnDirectComm then notebookMain.PageIndex := INT_PAGE_CONFIGCONNECTION; end; -procedure TformChess.pageBeforeShow(Sender: TObject; ANewPage: TUNBPage; ANewIndex: Integer); +procedure TformChess.pageBeforeShow(Sender: TObject; ANewPage: TPage; ANewIndex: Integer); begin if ANewIndex = INT_PAGE_CONFIGCONNECTION then begin