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

@@ -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

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.

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;

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

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);