diff --git a/applications/fpchess/chessgame.pas b/applications/fpchess/chessgame.pas
index 1eb35c626..0407d1b56 100644
--- a/applications/fpchess/chessgame.pas
+++ b/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;
diff --git a/applications/fpchess/chessmodules.pas b/applications/fpchess/chessmodules.pas
index 757b289f3..5a14fe917 100644
--- a/applications/fpchess/chessmodules.pas
+++ b/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.
diff --git a/applications/fpchess/fpchess.lpi b/applications/fpchess/fpchess.lpi
index 1544180cb..1873a9e58 100644
--- a/applications/fpchess/fpchess.lpi
+++ b/applications/fpchess/fpchess.lpi
@@ -68,7 +68,7 @@
-
+
@@ -134,6 +134,11 @@
+
+
+
+
+
diff --git a/applications/fpchess/fpchess.lpr b/applications/fpchess/fpchess.lpr
index 00bf5c574..eb7a9f042 100644
--- a/applications/fpchess/fpchess.lpr
+++ b/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};
diff --git a/applications/fpchess/mainform.lfm b/applications/fpchess/mainform.lfm
index 7e6dd4e6c..59b485075 100644
--- a/applications/fpchess/mainform.lfm
+++ b/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
- ClientWidth = 1440
- ClientHeight = 1732
- object Label3: TLabel
- AnchorSideRight.Control = pageConfigureGame
+ object pageGame: TPage
+ ClientWidth = 360
+ ClientHeight = 433
+ object Label5: TLabel
+ 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
- ClientHeight = 13856
+ ClientWidth = 720
+ 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
diff --git a/applications/fpchess/mainform.pas b/applications/fpchess/mainform.pas
index 4bf60f5f0..e0302cea8 100644
--- a/applications/fpchess/mainform.pas
+++ b/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_CONNECTING = 2;
- INT_PAGE_GAME = 3;
- INT_PAGE_AI = 4;
+ INT_PAGE_GAME = 1;
+ INT_PAGE_WEBSERVICE = 2;
{ 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;
diff --git a/applications/fpchess/mod_fics.pas b/applications/fpchess/mod_fics.pas
new file mode 100644
index 000000000..e1db0095d
--- /dev/null
+++ b/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.
+
diff --git a/applications/fpchess/mod_singleplayer.pas b/applications/fpchess/mod_singleplayer.pas
index 9cbaa231b..93cd3105c 100644
--- a/applications/fpchess/mod_singleplayer.pas
+++ b/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.