From f3267c88d30f9138b44cf2b61169baf8c2342369 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Tue, 30 Aug 2011 15:05:14 +0000 Subject: [PATCH] fpchess: Adds coordinates writing to the log git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1875 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- applications/fpchess/chessgame.pas | 61 +++++++++++++------ applications/fpchess/chessmodules.pas | 7 ++- .../fpchess/engines/kcchess/mod_kcchess.pas | 3 - applications/fpchess/mainform.lfm | 45 +++++++------- applications/fpchess/mainform.pas | 14 +++++ 5 files changed, 86 insertions(+), 44 deletions(-) diff --git a/applications/fpchess/chessgame.pas b/applications/fpchess/chessgame.pas index 3d8c49621..30399da66 100644 --- a/applications/fpchess/chessgame.pas +++ b/applications/fpchess/chessgame.pas @@ -71,6 +71,21 @@ type TChessGame = class private + function WillKingBeInCheck(AFrom, ATo, AEnpassantToClear: TPoint): Boolean; + function IsKingInCheck(AKingPos: TPoint): Boolean; + procedure DoMovePiece(AFrom, ATo, AEnpassantToClear: TPoint); + function ValidateRookMove(AFrom, ATo: TPoint) : boolean; + procedure ResetCastleVar(AFrom : TPoint); + 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 CheckPassageSquares(side: boolean; AFrom, ATo : TPoint) : boolean; + procedure DoCastle(); + function ValidatePawnMove(AFrom, ATo: TPoint; + var AEnpassantSquare, AEnpassantSquareToClear: TPoint) : boolean; + function ValidatePawnSimpleCapture(AFrom,ATo: TPoint): Boolean; + function IsSquareOccupied(ASquare: TPoint): Boolean; public Board: TChessBoard; msg : String; @@ -91,32 +106,21 @@ type Castle:boolean;//If the move will be a castle. CastleCord: TPoint; // Callbacks - OnMove: TOnMoveCallback; + OnAfterMove: TOnMoveCallback; // For the modules + OnBeforeMove: TOnMoveCallback; // For the UI // constructor Create; procedure StartNewGame(APlayAsWhite: Boolean; AUseTimer: Boolean; APlayerTime: Integer); overload; procedure StartNewGame(APlayAsWhite: Integer; AUseTimer: Boolean; APlayerTime: Integer); overload; function ClientToBoardCoords(AClientCoords: TPoint): TPoint; + function BoardPosToChessCoords(APos: TPoint): string; function CheckStartMove(AFrom: TPoint): Boolean; function CheckEndMove(ATo: TPoint): Boolean; - function WillKingBeInCheck(AFrom, ATo, AEnpassantToClear: TPoint): Boolean; - function IsKingInCheck(AKingPos: TPoint): Boolean; function FindKing(): TPoint; function MovePiece(AFrom, ATo: TPoint): Boolean; - procedure DoMovePiece(AFrom, ATo, AEnpassantToClear: TPoint); - function ValidateRookMove(AFrom, ATo: TPoint) : boolean; - procedure ResetCastleVar(AFrom : TPoint); - 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 CheckPassageSquares(side: boolean; AFrom, ATo : TPoint) : boolean; - procedure DoCastle(); - function ValidatePawnMove(AFrom, ATo: TPoint; - var AEnpassantSquare, AEnpassantSquareToClear: TPoint) : boolean; - function ValidatePawnSimpleCapture(AFrom,ATo: TPoint): Boolean; - function IsSquareOccupied(ASquare: TPoint): Boolean; procedure UpdateTimes(); + function GetCurrentPlayerName(): string; + function GetCurrentPlayerColor(): string; end; var @@ -259,11 +263,14 @@ begin // UpdateTimes(); + // Notify of the move + if Assigned(OnBeforeMove) then OnBeforeMove(AFrom, ATo); + // Change player IsWhitePlayerTurn := not IsWhitePlayerTurn; // Notify of the move - if Assigned(OnMove) then OnMove(AFrom, ATo); + if Assigned(OnAfterMove) then OnAfterMove(AFrom, ATo); end; { Really moves the piece without doing any check } @@ -693,12 +700,32 @@ begin else BlackPlayerTime := BlackPlayerTime - lTimeDelta; end; +function TChessGame.GetCurrentPlayerName: string; +begin + if IsWhitePlayerTurn then Result := 'White' + else Result := 'Black'; +end; + +function TChessGame.GetCurrentPlayerColor: string; +begin + if IsWhitePlayerTurn then Result := 'White' + else Result := 'Black'; +end; + function TChessGame.ClientToBoardCoords(AClientCoords: TPoint): TPoint; begin Result.X := 1 + AClientCoords.X div INT_CHESSTILE_SIZE; Result.Y := 1 + (INT_CHESSBOARD_SIZE - AClientCoords.Y) div INT_CHESSTILE_SIZE; end; +function TChessGame.BoardPosToChessCoords(APos: TPoint): string; +var + lStr: string; +begin + lStr := Char(APos.X + 96); + Result := Format('%s%d', [lStr, APos.Y]); +end; + // Check if we are moving to either an empty space or to an enemy piece function TChessGame.CheckEndMove(ATo: TPoint): Boolean; begin diff --git a/applications/fpchess/chessmodules.pas b/applications/fpchess/chessmodules.pas index 09d837492..9e340a38f 100644 --- a/applications/fpchess/chessmodules.pas +++ b/applications/fpchess/chessmodules.pas @@ -48,7 +48,10 @@ var lModule: TChessModule; begin lModule := GetChessModule(gSelectedModuleIndex); - lModule.HandleOnMove(AFrom, ATo); + + // If we are getting notified by a computer move, don't notify the module yet again + if not lModule.IsMovingAllowedNow() then + lModule.HandleOnMove(AFrom, ATo); end; procedure RegisterChessModule(AModule: TChessModule); @@ -98,7 +101,7 @@ end; initialization gChessModules := TList.Create; - vChessGame.OnMove := @HandleOnMove; + vChessGame.OnAfterMove := @HandleOnMove; finalization gChessModules.Free; end. diff --git a/applications/fpchess/engines/kcchess/mod_kcchess.pas b/applications/fpchess/engines/kcchess/mod_kcchess.pas index 7e20af7bf..8674c5144 100644 --- a/applications/fpchess/engines/kcchess/mod_kcchess.pas +++ b/applications/fpchess/engines/kcchess/mod_kcchess.pas @@ -278,9 +278,6 @@ var Escape: boolean; Score: Integer; begin - // If we are getting notified by a computer move, exit immediately - if IsMovingAllowedNow() then Exit; - // initialization Escape := False; Score := 0; diff --git a/applications/fpchess/mainform.lfm b/applications/fpchess/mainform.lfm index cd0ff6d04..acd87d5ae 100644 --- a/applications/fpchess/mainform.lfm +++ b/applications/fpchess/mainform.lfm @@ -45,17 +45,17 @@ object formChess: TformChess end object Label6: TLabel Left = 28 - Height = 17 + Height = 18 Top = 128 - Width = 52 + Width = 56 Caption = 'Start as:' ParentColor = False end object Label7: TLabel Left = 80 - Height = 17 + Height = 18 Top = 175 - Width = 150 + Width = 152 Caption = 'minutes for each player' ParentColor = False end @@ -70,7 +70,7 @@ object formChess: TformChess end object editPlayerName: TLabeledEdit Left = 88 - Height = 22 + Height = 25 Top = 104 Width = 120 EditLabel.AnchorSideLeft.Control = editPlayerName @@ -78,10 +78,10 @@ object formChess: TformChess EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = editPlayerName EditLabel.AnchorSideBottom.Control = editPlayerName - EditLabel.Left = 6 - EditLabel.Height = 17 + EditLabel.Left = 2 + EditLabel.Height = 18 EditLabel.Top = 107 - EditLabel.Width = 79 + EditLabel.Width = 83 EditLabel.Caption = 'Player Name' EditLabel.ParentColor = False LabelPosition = lpLeft @@ -89,7 +89,7 @@ object formChess: TformChess end object comboStartColor: TComboBox Left = 88 - Height = 21 + Height = 27 Top = 128 Width = 120 ItemHeight = 0 @@ -103,9 +103,9 @@ object formChess: TformChess end object checkTimer: TCheckBox Left = 24 - Height = 18 + Height = 21 Top = 152 - Width = 212 + Width = 220 Caption = 'Set a time limit for each Player' Checked = True State = cbChecked @@ -113,7 +113,7 @@ object formChess: TformChess end object spinPlayerTime: TSpinEdit Left = 21 - Height = 16 + Height = 25 Top = 176 Width = 50 TabOrder = 4 @@ -121,7 +121,7 @@ object formChess: TformChess end object comboGameMode: TComboBox Left = 8 - Height = 21 + Height = 27 Top = 74 Width = 346 ItemHeight = 0 @@ -140,7 +140,7 @@ object formChess: TformChess end object editLocalIP: TLabeledEdit Left = 120 - Height = 22 + Height = 25 Top = 200 Width = 120 EditLabel.AnchorSideLeft.Control = editLocalIP @@ -148,10 +148,10 @@ object formChess: TformChess EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = editLocalIP EditLabel.AnchorSideBottom.Control = editLocalIP - EditLabel.Left = 12 - EditLabel.Height = 17 + EditLabel.Left = 15 + EditLabel.Height = 18 EditLabel.Top = 203 - EditLabel.Width = 105 + EditLabel.Width = 102 EditLabel.Caption = 'Your IP Address:' EditLabel.ParentColor = False LabelPosition = lpLeft @@ -173,15 +173,15 @@ object formChess: TformChess ClientHeight = 500 object labelPos: TLabel Left = 8 - Height = 17 + Height = 18 Top = 392 - Width = 53 + Width = 54 Caption = 'labelPos' ParentColor = False end object labelTime: TLabel Left = 8 - Height = 17 + Height = 18 Top = 408 Width = 62 Caption = 'labelTime' @@ -199,6 +199,7 @@ object formChess: TformChess Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Right = 5 BorderSpacing.Bottom = 5 + ScrollBars = ssVertical TabOrder = 0 end object btnResign: TBitBtn @@ -229,8 +230,8 @@ object formChess: TformChess end end object pageWebservice: TPage - ClientWidth = 1440 - ClientHeight = 1732 + ClientWidth = 2880 + ClientHeight = 3464 object Label8: TLabel Left = 0 Height = 32 diff --git a/applications/fpchess/mainform.pas b/applications/fpchess/mainform.pas index ca08ead75..0a0ebb06e 100644 --- a/applications/fpchess/mainform.pas +++ b/applications/fpchess/mainform.pas @@ -77,6 +77,8 @@ var formChess: TformChess; vFormDrawerDelegate: TFormDrawerDelegate; +procedure HandleOnMove(AFrom, ATo: TPoint); + implementation {$R *.lfm} @@ -130,6 +132,15 @@ begin GetChessModule(ANewIndex).ShowUserInterface(panelModules); end; +procedure HandleOnMove(AFrom, ATo: TPoint); +var + lStr: String; +begin + lStr := vChessGame.GetCurrentPlayerColor(); + lStr := Format('%s executed the move %s-%s', [lStr, vChessGame.BoardPosToChessCoords(AFrom), vChessGame.BoardPosToChessCoords(ATo)]); + formChess.MemoDebug.Lines.Add(lStr); +end; + procedure TformChess.UpdateCaptions; var lStr: string; @@ -178,6 +189,9 @@ begin gSelectedModuleIndex := 0; end; gChessModulesDebugOutputDestiny := memoDebug; + + // Prepare the move callback + vChessGame.OnBeforeMove := @HandleOnMove; end; procedure TformChess.btnQuitClick(Sender: TObject);