fpchess: Advances the modules interface

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1843 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/fpchess/chessgame.pas

@@ -65,6 +65,8 @@ type
     PieceMoved, PieceEaten: TChessTile;
   end;
 
+  TOnMoveCallback = procedure (AFrom, ATo: TPoint);
+
   { TChessGame }
 
   TChessGame = class
@@ -72,7 +74,7 @@ type
   public
     Board: TChessBoard;
     msg : String;
-    CurrentPlayerIsWhite: Boolean;
+    FirstPlayerIsWhite, IsWhitePlayerTurn: Boolean;
     Dragging: Boolean;
     DragStart, MouseMovePos: TPoint;
     UseTimer: Boolean;
@@ -88,6 +90,8 @@ type
     IsBlackLeftRoquePossible, IsBlackRightRoquePossible: Boolean;
     Castle:boolean;//If the move will be a castle.
     CastleCord: TPoint;
+    // Callbacks
+    OnMove: TOnMoveCallback;
     //
     constructor Create;
     procedure StartNewGame(APlayAsWhite: Boolean; AUseTimer: Boolean; APlayerTime: Integer); overload;
@@ -142,7 +146,8 @@ var
   j: Integer;
 begin
   UseTimer := AUseTimer;
-  CurrentPlayerIsWhite := True;
+  FirstPlayerIsWhite := APlayAsWhite;
+  IsWhitePlayerTurn := True;
   WhitePlayerTime := APlayerTime * 60 * 1000; // minutes to milisseconds
   BlackPlayerTime := APlayerTime * 60 * 1000; // minutes to milisseconds
   MoveStartTime := Now;
@@ -255,7 +260,7 @@ begin
   UpdateTimes();
 
   // Change player
-  CurrentPlayerIsWhite := not CurrentPlayerIsWhite;
+  IsWhitePlayerTurn := not IsWhitePlayerTurn;
 end;
 
 { Really moves the piece without doing any check }
@@ -268,6 +273,9 @@ begin
   // If Enpassant, clear the remaining pawn
   if AEnpassantToClear.X <> -1 then
     Board[AEnpassantToClear.X][AEnpassantToClear.Y] := ctEmpty;
+
+  // Notify of the move
+  if Assigned(OnMove) then OnMove(AFrom, ATo);
 end;
 
 procedure TChessGame.DoCastle();
@@ -424,7 +432,7 @@ begin
   Result := False;
 
   // Verify the possibility of a Roque
-  if CurrentPlayerIsWhite then
+  if IsWhitePlayerTurn then
   begin
     // Castle to the right
     if IsWhiteRightRoquePossible and (AFrom.X = 5) and (AFrom.Y = 1)
@@ -490,7 +498,7 @@ begin
 
   LocalBoard:=Board;
 
-  if CurrentPlayerIsWhite then
+  if IsWhitePlayerTurn then
   begin
     if side then
     begin
@@ -553,7 +561,7 @@ begin
   AEnpassantSquareToClear := Point(-1, -1);
   Result := False;
 
-  if CurrentPlayerIsWhite then
+  if IsWhitePlayerTurn then
   begin
     // Normal move forward
     if (AFrom.X = ATo.X) and (AFrom.Y = ATo.Y - 1) then
@@ -638,7 +646,7 @@ end;
 function TChessGame.ValidatePawnSimpleCapture(AFrom,ATo: TPoint): Boolean;
 begin
   result:=false;
-  if not CurrentPlayerIsWhite then
+  if not IsWhitePlayerTurn then
   begin
     // Normal capture in the left
     if (ATo.X = AFrom.X-1) and (ATo.Y = AFrom.Y+1) and IsSquareOccupied(ATo) then
@@ -681,7 +689,7 @@ begin
   lTimeDelta := MilliSecondsBetween(lNow, MoveStartTime);
   MoveStartTime := lNow;
 
-  if CurrentPlayerIsWhite then WhitePlayerTime := WhitePlayerTime - lTimeDelta
+  if IsWhitePlayerTurn then WhitePlayerTime := WhitePlayerTime - lTimeDelta
   else BlackPlayerTime := BlackPlayerTime - lTimeDelta;
 end;
 
@@ -694,7 +702,7 @@ end;
 // Check if we are moving to either an empty space or to an enemy piece
 function TChessGame.CheckEndMove(ATo: TPoint): Boolean;
 begin
-  if CurrentPlayerIsWhite then
+  if IsWhitePlayerTurn then
     Result := Board[ATo.X][ATo.Y] in BlackPiecesOrEmpty
   else
     Result := Board[ATo.X][ATo.Y] in WhitePiecesOrEmpty;
@@ -707,7 +715,7 @@ end;
 }
 function TChessGame.CheckStartMove(AFrom: TPoint): Boolean;
 begin
-  if CurrentPlayerIsWhite then
+  if IsWhitePlayerTurn then
     Result := Board[AFrom.X][AFrom.Y] in WhitePieces
   else
     Result := Board[AFrom.X][AFrom.Y] in BlackPieces;
@@ -744,7 +752,7 @@ begin
     for j:=1 to 8 do
     begin
       piecePos := Point(i, j);
-      if not (CurrentPlayerIsWhite) then
+      if not (IsWhitePlayerTurn) then
       begin
         case Board[i][j] of
         ctWRook:   Result:= ValidateRookMove(piecePos,AKingPos);
@@ -779,12 +787,12 @@ begin
 
   for i:=1 to 8 do
     for j:=1 to 8 do
-    if (CurrentPlayerIsWhite) and (Board[i][j]=ctWKing) then
+    if (IsWhitePlayerTurn) and (Board[i][j]=ctWKing) then
     begin
       Result := Point(i, j);
       Exit;
     end
-    else if (not CurrentPlayerIsWhite) and (Board[i][j]=ctBKing) then
+    else if (not IsWhitePlayerTurn) and (Board[i][j]=ctBKing) then
     begin
       Result := Point(i, j);
       Exit;

applications/fpchess/chessmodules.pas

@@ -6,7 +6,8 @@ interface
 
 uses
   Classes, SysUtils,
-  Controls;
+  Controls,
+  chessgame;
 
 type
   TChessModuleKind = (cmkSinglePlayer, cmkInternet, cmkAI);
@@ -19,21 +20,35 @@ type
     procedure ShowUserInterface(AParent: TWinControl); virtual; abstract;
     procedure HideUserInterface(); virtual; abstract;
     procedure FreeUserInterface(); virtual; abstract;
+    procedure PrepareForGame(); virtual; abstract;
+    function IsMovingAllowedNow(): Boolean; virtual; abstract;
+    function GetSecondPlayerName(): string; virtual; abstract;
+    procedure HandleOnMove(AFrom, ATo: TPoint); virtual; abstract;
   end;
 
 var
-  gSelectedModuleIndex: Integer;
+  gSelectedModuleIndex: Integer = -1;
+  gChessModulesDebugOutputDestiny: TStrings = nil;
 
 procedure RegisterChessModule(AModule: TChessModule);
 procedure PopulateChessModulesList(AList: TStrings);
 function GetChessModule(AIndex: Integer): TChessModule;
 function GetChessModuleCount(): Integer;
+procedure ChessModuleDebugLn(AStr: string);
 
 implementation
 
 var
   gChessModules: TList;
 
+procedure HandleOnMove(AFrom, ATo: TPoint);
+var
+  lModule: TChessModule;
+begin
+  lModule := GetChessModule(gSelectedModuleIndex);
+  lModule.HandleOnMove(AFrom, ATo);
+end;
+
 procedure RegisterChessModule(AModule: TChessModule);
 begin
   if AModule = nil then raise Exception.Create('[RegisterChessModule] Attempted to register a nil module');
@@ -66,9 +81,15 @@ begin
   Result := gChessModules.Count;
 end;
 
+procedure ChessModuleDebugLn(AStr: string);
+begin
+  if Assigned(gChessModulesDebugOutputDestiny) then
+    gChessModulesDebugOutputDestiny.Add(AStr);
+end;
+
 initialization
   gChessModules := TList.Create;
-  gSelectedModuleIndex := -1;
+  vChessGame.OnMove := @HandleOnMove;
 finalization
   gChessModules.Free;
 end.

applications/fpchess/fpchess.lpi

@@ -68,7 +68,7 @@
         <PackageName Value="LCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="13">
+    <Units Count="14">
       <Unit0>
         <Filename Value="fpchess.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -134,6 +134,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="mod_singleplayer"/>
       </Unit12>
+      <Unit13>
+        <Filename Value="mod_fics.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="mod_fics"/>
+      </Unit13>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

applications/fpchess/fpchess.lpr

@@ -8,7 +8,7 @@ uses
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
   Forms, lnetbase, mainform, chessdrawer, chessgame, chessconfig,
-  chesstcputils, chessmodules, mod_singleplayer
+  chesstcputils, chessmodules, mod_singleplayer, mod_fics
   {$ifdef FPCHESS_WEBSERVICES}
   ,IDelphiChess_Intf
   {$endif};

applications/fpchess/mainform.lfm

@@ -14,7 +14,7 @@ object formChess: TformChess
     Height = 433
     Top = 0
     Width = 360
-    PageIndex = 0
+    PageIndex = 1
     Align = alClient
     TabOrder = 0
     TabStop = True
@@ -157,11 +157,11 @@ object formChess: TformChess
         TabOrder = 7
       end
     end
-    object pageConfigureGame: TPage
+    object pageGame: TPage
-      ClientWidth = 1440
+      ClientWidth = 360
-      ClientHeight = 1732
+      ClientHeight = 433
-      object Label3: TLabel
+      object Label5: TLabel
-        AnchorSideRight.Control = pageConfigureGame
+        AnchorSideRight.Control = pageGame
         AnchorSideRight.Side = asrBottom
         Left = 0
         Height = 32
@@ -170,81 +170,6 @@ object formChess: TformChess
         Alignment = taCenter
         Anchors = [akTop, akLeft, akRight]
         AutoSize = False
-        Caption = 'Configure Game'
-        Font.Height = -19
-        ParentColor = False
-        ParentFont = False
-      end
-      object editRemoteID: TLabeledEdit
-        Left = 112
-        Height = 22
-        Top = 104
-        Width = 120
-        EditLabel.AnchorSideLeft.Control = editRemoteID
-        EditLabel.AnchorSideTop.Control = editRemoteID
-        EditLabel.AnchorSideTop.Side = asrCenter
-        EditLabel.AnchorSideRight.Control = editRemoteID
-        EditLabel.AnchorSideBottom.Control = editRemoteID
-        EditLabel.Left = 8
-        EditLabel.Height = 17
-        EditLabel.Top = 107
-        EditLabel.Width = 101
-        EditLabel.Caption = 'Your friend''s IP:'
-        EditLabel.ParentColor = False
-        LabelPosition = lpLeft
-        TabOrder = 0
-      end
-      object btnConnect: TBitBtn
-        Left = 49
-        Height = 30
-        Top = 264
-        Width = 224
-        Caption = 'Connect'
-        OnClick = btnConnectClick
-        TabOrder = 1
-      end
-      object Label10: TLabel
-        Left = 8
-        Height = 17
-        Top = 48
-        Width = 170
-        Caption = 'Please choose how to play:'
-        ParentColor = False
-      end
-    end
-    object pageConnecting: TPage
-      ClientWidth = 11520
-      ClientHeight = 13856
-      object Label4: TLabel
-        Left = 0
-        Height = 32
-        Top = 8
-        Width = 240
-        Alignment = taCenter
-        AutoSize = False
-        Caption = 'Connecting'
-        Font.Height = -19
-        ParentColor = False
-        ParentFont = False
-      end
-      object ProgressBar1: TProgressBar
-        Left = 8
-        Height = 20
-        Top = 56
-        Width = 100
-        TabOrder = 0
-      end
-    end
-    object pageGame: TPage
-      ClientWidth = 11520
-      ClientHeight = 13856
-      object Label5: TLabel
-        Left = 0
-        Height = 32
-        Top = 8
-        Width = 240
-        Alignment = taCenter
-        AutoSize = False
         Caption = 'Playing'
         Font.Height = -19
         ParentColor = False
@@ -268,8 +193,8 @@ object formChess: TformChess
       end
     end
     object pageWebservice: TPage
-      ClientWidth = 11520
+      ClientWidth = 720
-      ClientHeight = 13856
+      ClientHeight = 866
       object Label8: TLabel
         Left = 0
         Height = 32
@@ -292,7 +217,7 @@ object formChess: TformChess
         EditLabel.AnchorSideTop.Side = asrCenter
         EditLabel.AnchorSideRight.Control = editPlayerName
         EditLabel.AnchorSideBottom.Control = editPlayerName
-        EditLabel.Left = -1062
+        EditLabel.Left = -6462
         EditLabel.Height = 17
         EditLabel.Top = 75
         EditLabel.Width = 79

applications/fpchess/mainform.pas

@@ -27,7 +27,6 @@ type
   { TformChess }
 
   TformChess = class(TForm)
-    btnConnect: TBitBtn;
     BitBtn3: TBitBtn;
     btnPlayAgainstAI: TButton;
     checkTimer: TCheckBox;
@@ -36,11 +35,8 @@ type
     editLocalIP: TLabeledEdit;
     editWebserviceURL: TLabeledEdit;
     Label1: TLabel;
-    Label10: TLabel;
     labelTime: TLabel;
     Label2: TLabel;
-    Label3: TLabel;
-    Label4: TLabel;
     Label5: TLabel;
     Label6: TLabel;
     Label7: TLabel;
@@ -48,19 +44,14 @@ type
     Label9: TLabel;
     editWebServiceAI: TLabeledEdit;
     labelPos: TLabel;
-    editRemoteID: TLabeledEdit;
     editPlayerName: TLabeledEdit;
     pageStart: TPage;
-    pageConfigureGame: TPage;
     notebookMain: TNotebook;
-    pageConnecting: TPage;
     panelModules: TPanel;
-    ProgressBar1: TProgressBar;
     pageGame: TPage;
     spinPlayerTime: TSpinEdit;
     timerChessTimer: TTimer;
     pageWebservice: TPage;
-    procedure btnConnectClick(Sender: TObject);
     procedure btnPlayAgainstAIClick(Sender: TObject);
     procedure comboGameModeSelect(Sender: TObject);
     procedure FormCreate(Sender: TObject);
@@ -85,10 +76,8 @@ implementation
 
 const
   INT_PAGE_START = 0;
-  INT_PAGE_CONFIGUREGAME = 1;
+  INT_PAGE_GAME = 1;
-  INT_PAGE_CONNECTING = 2;
+  INT_PAGE_WEBSERVICE = 2;
-  INT_PAGE_GAME = 3;
-  INT_PAGE_AI = 4;
 
 { TformChess }
 
@@ -138,7 +127,7 @@ procedure TformChess.UpdateCaptions;
 var
   lStr: string;
 begin
-  if vChessGame.CurrentPlayerIsWhite then lStr := 'White playing'
+  if vChessGame.IsWhitePlayerTurn then lStr := 'White playing'
   else lStr := 'Black playing';
 
   lStr := lStr + Format(' X: %d Y: %d',
@@ -182,12 +171,6 @@ begin
   end;
 end;
 
-procedure TformChess.btnConnectClick(Sender: TObject);
-begin
-  notebookMain.PageIndex := INT_PAGE_CONNECTING;
-
-end;
-
 procedure TformChess.btnPlayAgainstAIClick(Sender: TObject);
 begin
   InitializeGameModel();
@@ -217,7 +200,11 @@ procedure TFormDrawerDelegate.HandleMouseUp(Sender: TObject;
   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 var
   lCoords: TPoint;
+  lModule: TChessModule;
 begin
+  lModule := GetChessModule(gSelectedModuleIndex);
+  if not lModule.IsMovingAllowedNow() then Exit;
+
   vChessGame.Dragging := False;
 
   lCoords := vChessGame.ClientToBoardCoords(Point(X, Y));
@@ -231,7 +218,11 @@ procedure TFormDrawerDelegate.HandleMouseDown(Sender: TObject;
   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 var
   lCoords: TPoint;
+  lModule: TChessModule;
 begin
+  lModule := GetChessModule(gSelectedModuleIndex);
+  if not lModule.IsMovingAllowedNow() then Exit;
+
   lCoords := vChessGame.ClientToBoardCoords(Point(X, Y));
   if not vChessGame.CheckStartMove(lCoords) then Exit;
 

applications/fpchess/mod_fics.pas

@@ -0,0 +1,107 @@
+{
+  For playing through the internet via FICS - Free Internet Chess Server
+
+  Based on this article:
+  http://blog.mekk.waw.pl/archives/7-How-to-write-a-FICS-bot-part-I.html
+
+  FICS website:
+  http://www.freechess.org/
+}
+unit mod_fics;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  StdCtrls, Forms, Controls,
+  chessmodules, chessgame;
+
+type
+
+  { TSinglePlayerChessModule }
+
+  TSinglePlayerChessModule = class(TChessModule)
+  public
+    SecondPlayerName: string;
+    constructor Create();
+    procedure CreateUserInterface(); override;
+    procedure ShowUserInterface(AParent: TWinControl); override;
+    procedure HideUserInterface(); override;
+    procedure FreeUserInterface(); override;
+    procedure PrepareForGame(); override;
+    function IsMovingAllowedNow(): Boolean; override;
+    function GetSecondPlayerName(): string; override;
+    procedure HandleOnMove(AFrom, ATo: TPoint); override;
+  end;
+
+implementation
+
+{ TSinglePlayerChessModule }
+
+constructor TSinglePlayerChessModule.Create;
+begin
+  inherited Create;
+
+  Description := 'Play online via the Free Internet Chess Server';
+  Kind := cmkSinglePlayer;
+end;
+
+procedure TSinglePlayerChessModule.CreateUserInterface;
+begin
+{  textSecondPlayerName := TStaticText.Create(nil);
+  textSecondPlayerName.SetBounds(20, 20, 180, 50);
+  textSecondPlayerName.Caption := 'Name of the second player';
+
+  editSecondPlayerName := TEdit.Create(nil);
+  editSecondPlayerName.SetBounds(200, 20, 150, 50);
+  editSecondPlayerName.Text := 'Second player';}
+end;
+
+procedure TSinglePlayerChessModule.ShowUserInterface(AParent: TWinControl);
+begin
+{  textSecondPlayerName.Parent := AParent;
+  editSecondPlayerName.Parent := AParent;}
+end;
+
+procedure TSinglePlayerChessModule.HideUserInterface();
+begin
+{  textSecondPlayerName.Parent := nil;
+  editSecondPlayerName.Parent := nil;}
+end;
+
+procedure TSinglePlayerChessModule.FreeUserInterface;
+begin
+{  textSecondPlayerName.Free;
+  editSecondPlayerName.Free;}
+end;
+
+procedure TSinglePlayerChessModule.PrepareForGame;
+begin
+//  SecondPlayerName := editSecondPlayerName.Text;
+
+
+end;
+
+function TSinglePlayerChessModule.IsMovingAllowedNow: Boolean;
+begin
+  Result := not (vChessGame.IsWhitePlayerTurn xor vChessGame.FirstPlayerIsWhite);
+end;
+
+function TSinglePlayerChessModule.GetSecondPlayerName: string;
+begin
+//  Result := SecondPlayerName;
+end;
+
+// If a move came, it is because the local player did a move
+// so send this move and start listening for a move
+procedure TSinglePlayerChessModule.HandleOnMove(AFrom, ATo: TPoint);
+begin
+
+end;
+
+initialization
+  RegisterChessModule(TSinglePlayerChessModule.Create);
+end.
+

applications/fpchess/mod_singleplayer.pas

@@ -24,6 +24,10 @@ type
     procedure ShowUserInterface(AParent: TWinControl); override;
     procedure HideUserInterface(); override;
     procedure FreeUserInterface(); override;
+    procedure PrepareForGame(); override;
+    function IsMovingAllowedNow(): Boolean; override;
+    function GetSecondPlayerName(): string; override;
+    procedure HandleOnMove(AFrom, ATo: TPoint); override;
   end;
 
 implementation
@@ -67,6 +71,26 @@ begin
   editSecondPlayerName.Free;
 end;
 
+procedure TSinglePlayerChessModule.PrepareForGame;
+begin
+  SecondPlayerName := editSecondPlayerName.Text;
+end;
+
+function TSinglePlayerChessModule.IsMovingAllowedNow: Boolean;
+begin
+  Result := True;
+end;
+
+function TSinglePlayerChessModule.GetSecondPlayerName: string;
+begin
+  Result := SecondPlayerName;
+end;
+
+procedure TSinglePlayerChessModule.HandleOnMove(AFrom, ATo: TPoint);
+begin
+
+end;
+
 initialization
   RegisterChessModule(TSinglePlayerChessModule.Create);
 end.