fpchess: Starts making the game modular

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1842 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-08-27 20:14:54 +00:00
parent 0c664731be
commit 8b93de655c
6 changed files with 306 additions and 160 deletions

View File

@ -0,0 +1,75 @@
unit chessmodules;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
Controls;
type
TChessModuleKind = (cmkSinglePlayer, cmkInternet, cmkAI);
TChessModule = class
public
Kind: TChessModuleKind;
Description: string;
procedure CreateUserInterface(); virtual; abstract;
procedure ShowUserInterface(AParent: TWinControl); virtual; abstract;
procedure HideUserInterface(); virtual; abstract;
procedure FreeUserInterface(); virtual; abstract;
end;
var
gSelectedModuleIndex: Integer;
procedure RegisterChessModule(AModule: TChessModule);
procedure PopulateChessModulesList(AList: TStrings);
function GetChessModule(AIndex: Integer): TChessModule;
function GetChessModuleCount(): Integer;
implementation
var
gChessModules: TList;
procedure RegisterChessModule(AModule: TChessModule);
begin
if AModule = nil then raise Exception.Create('[RegisterChessModule] Attempted to register a nil module');
gChessModules.Add(AModule);
AModule.CreateUserInterface();
end;
procedure PopulateChessModulesList(AList: TStrings);
var
i: Integer;
lModule: TChessModule;
begin
AList.Clear;
for i := 0 to gChessModules.Count - 1 do
begin
lModule := TChessModule(gChessModules.Items[i]);
if lModule <> nil then
AList.Add(lModule.Description);
end;
end;
function GetChessModule(AIndex: Integer): TChessModule;
begin
if AIndex < 0 then Exit(nil);
Result := TChessModule(gChessModules.Items[AIndex]);
end;
function GetChessModuleCount: Integer;
begin
Result := gChessModules.Count;
end;
initialization
gChessModules := TList.Create;
gSelectedModuleIndex := -1;
finalization
gChessModules.Free;
end.

View File

@ -60,22 +60,15 @@
<LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="4"> <RequiredPackages Count="2">
<Item1> <Item1>
<PackageName Value="LCLBase"/> <PackageName Value="lnetbase"/>
<MinVersion Major="1" Release="1" Valid="True"/>
</Item1> </Item1>
<Item2> <Item2>
<PackageName Value="laz_synapse"/>
</Item2>
<Item3>
<PackageName Value="wst_synapse"/>
</Item3>
<Item4>
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item4> </Item2>
</RequiredPackages> </RequiredPackages>
<Units Count="11"> <Units Count="13">
<Unit0> <Unit0>
<Filename Value="fpchess.lpr"/> <Filename Value="fpchess.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -131,6 +124,16 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="IDelphiChess_Intf"/> <UnitName Value="IDelphiChess_Intf"/>
</Unit10> </Unit10>
<Unit11>
<Filename Value="chessmodules.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="chessmodules"/>
</Unit11>
<Unit12>
<Filename Value="mod_singleplayer.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mod_singleplayer"/>
</Unit12>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

View File

@ -7,8 +7,11 @@ uses
cthreads, cthreads,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset Interfaces, // this includes the LCL widgetset
Forms, laz_synapse, mainform, chessdrawer, chessgame, chessconfig, Forms, lnetbase, mainform, chessdrawer, chessgame, chessconfig,
chesstcputils, IDelphiChess_Intf, wst_synapse; chesstcputils, chessmodules, mod_singleplayer
{$ifdef FPCHESS_WEBSERVICES}
,IDelphiChess_Intf
{$endif};
//{$R *.res} //{$R *.res}

View File

@ -1,7 +1,7 @@
object formChess: TformChess object formChess: TformChess
Left = 181 Left = 216
Height = 433 Height = 433
Top = 209 Top = 164
Width = 360 Width = 360
ActiveControl = notebookMain ActiveControl = notebookMain
Caption = 'FP Chess 0.1' Caption = 'FP Chess 0.1'
@ -14,7 +14,7 @@ object formChess: TformChess
Height = 433 Height = 433
Top = 0 Top = 0
Width = 360 Width = 360
PageIndex = 3 PageIndex = 0
Align = alClient Align = alClient
TabOrder = 0 TabOrder = 0
TabStop = True TabStop = True
@ -35,7 +35,7 @@ object formChess: TformChess
end end
object Label2: TLabel object Label2: TLabel
Left = 8 Left = 8
Height = 30 Height = 40
Top = 40 Top = 40
Width = 352 Width = 352
AutoSize = False AutoSize = False
@ -46,7 +46,7 @@ object formChess: TformChess
object Label6: TLabel object Label6: TLabel
Left = 28 Left = 28
Height = 17 Height = 17
Top = 104 Top = 128
Width = 52 Width = 52
Caption = 'Start as:' Caption = 'Start as:'
ParentColor = False ParentColor = False
@ -54,43 +54,23 @@ object formChess: TformChess
object Label7: TLabel object Label7: TLabel
Left = 80 Left = 80
Height = 17 Height = 17
Top = 163 Top = 175
Width = 150 Width = 150
Caption = 'minutes for each player' Caption = 'minutes for each player'
ParentColor = False ParentColor = False
end end
object btnSinglePlayer: TBitBtn
Left = 24
Height = 30
Top = 200
Width = 304
Caption = 'Play Against the Computer'
Enabled = False
OnClick = HandleMainScreenButton
TabOrder = 0
end
object btnDirectComm: TBitBtn
Left = 24
Height = 30
Top = 280
Width = 304
Caption = 'Play with a friend through a direct connection'
Enabled = False
OnClick = HandleMainScreenButton
TabOrder = 1
end
object BitBtn3: TBitBtn object BitBtn3: TBitBtn
Left = 24 Left = 24
Height = 30 Height = 30
Top = 360 Top = 392
Width = 304 Width = 304
Caption = 'Quit' Caption = 'Quit'
TabOrder = 2 TabOrder = 0
end end
object editPlayerName: TLabeledEdit object editPlayerName: TLabeledEdit
Left = 88 Left = 88
Height = 22 Height = 22
Top = 72 Top = 104
Width = 120 Width = 120
EditLabel.AnchorSideLeft.Control = editPlayerName EditLabel.AnchorSideLeft.Control = editPlayerName
EditLabel.AnchorSideTop.Control = editPlayerName EditLabel.AnchorSideTop.Control = editPlayerName
@ -99,17 +79,17 @@ object formChess: TformChess
EditLabel.AnchorSideBottom.Control = editPlayerName EditLabel.AnchorSideBottom.Control = editPlayerName
EditLabel.Left = 6 EditLabel.Left = 6
EditLabel.Height = 17 EditLabel.Height = 17
EditLabel.Top = 75 EditLabel.Top = 107
EditLabel.Width = 79 EditLabel.Width = 79
EditLabel.Caption = 'Player Name' EditLabel.Caption = 'Player Name'
EditLabel.ParentColor = False EditLabel.ParentColor = False
LabelPosition = lpLeft LabelPosition = lpLeft
TabOrder = 3 TabOrder = 1
end end
object comboStartColor: TComboBox object comboStartColor: TComboBox
Left = 88 Left = 88
Height = 21 Height = 21
Top = 104 Top = 128
Width = 120 Width = 120
ItemHeight = 0 ItemHeight = 0
ItemIndex = 0 ItemIndex = 0
@ -117,113 +97,124 @@ object formChess: TformChess
'White' 'White'
'Black' 'Black'
) )
TabOrder = 4 TabOrder = 2
Text = 'White' Text = 'White'
end end
object checkTimer: TCheckBox object checkTimer: TCheckBox
Left = 24 Left = 24
Height = 18 Height = 18
Top = 136 Top = 152
Width = 212 Width = 212
Caption = 'Set a time limit for each Player' Caption = 'Set a time limit for each Player'
Checked = True Checked = True
State = cbChecked State = cbChecked
TabOrder = 5 TabOrder = 3
end end
object spinPlayerTime: TSpinEdit object spinPlayerTime: TSpinEdit
Left = 21 Left = 21
Height = 16 Height = 16
Top = 160 Top = 176
Width = 50 Width = 50
TabOrder = 6 TabOrder = 4
Value = 30 Value = 30
end end
object btnHotSeat: TBitBtn object comboGameMode: TComboBox
Left = 24 Left = 8
Height = 30
Top = 240
Width = 304
Caption = 'Play with a friend in the same Computer'
OnClick = HandleMainScreenButton
TabOrder = 7
end
object btnAI: TBitBtn
Left = 24
Height = 30
Top = 320
Width = 304
Caption = 'Play against the Computer'
OnClick = HandleMainScreenButton
TabOrder = 8
end
end
object pageConfigConnection: TPage
ClientWidth = 1424
ClientHeight = 1620
object Label3: TLabel
Left = 0
Height = 32
Top = 8
Width = 240
Alignment = taCenter
AutoSize = False
Caption = 'Direct Connection'
Font.Height = -19
ParentColor = False
ParentFont = False
end
object editRemoteID: TLabeledEdit
Left = 112
Height = 21 Height = 21
Top = 72 Top = 74
Width = 120 Width = 338
EditLabel.AnchorSideLeft.Control = editRemoteID ItemHeight = 0
EditLabel.AnchorSideTop.Control = editRemoteID OnSelect = comboGameModeSelect
EditLabel.AnchorSideTop.Side = asrCenter TabOrder = 5
EditLabel.AnchorSideRight.Control = editRemoteID Text = 'comboGameMode'
EditLabel.AnchorSideBottom.Control = editRemoteID end
EditLabel.Left = 31 object panelModules: TPanel
EditLabel.Height = 14 Left = 8
EditLabel.Top = 75 Height = 161
EditLabel.Width = 78 Top = 224
EditLabel.Caption = 'Your friend''s IP:' Width = 344
EditLabel.ParentColor = False BevelOuter = bvNone
LabelPosition = lpLeft TabOrder = 6
TabOrder = 0
end end
object editLocalIP: TLabeledEdit object editLocalIP: TLabeledEdit
Left = 112 Left = 120
Height = 21 Height = 22
Top = 104 Top = 200
Width = 120 Width = 120
EditLabel.AnchorSideLeft.Control = editLocalIP EditLabel.AnchorSideLeft.Control = editLocalIP
EditLabel.AnchorSideTop.Control = editLocalIP EditLabel.AnchorSideTop.Control = editLocalIP
EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = editLocalIP EditLabel.AnchorSideRight.Control = editLocalIP
EditLabel.AnchorSideBottom.Control = editLocalIP EditLabel.AnchorSideBottom.Control = editLocalIP
EditLabel.Left = 27 EditLabel.Left = 12
EditLabel.Height = 14 EditLabel.Height = 17
EditLabel.Top = 107 EditLabel.Top = 203
EditLabel.Width = 82 EditLabel.Width = 105
EditLabel.Caption = 'Your IP Address:' EditLabel.Caption = 'Your IP Address:'
EditLabel.ParentColor = False EditLabel.ParentColor = False
LabelPosition = lpLeft LabelPosition = lpLeft
ReadOnly = True ReadOnly = True
TabOrder = 1 TabOrder = 7
end
end
object pageConfigureGame: TPage
ClientWidth = 1440
ClientHeight = 1732
object Label3: TLabel
AnchorSideRight.Control = pageConfigureGame
AnchorSideRight.Side = asrBottom
Left = 0
Height = 32
Top = 8
Width = 360
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 end
object btnConnect: TBitBtn object btnConnect: TBitBtn
Left = 8 Left = 49
Height = 30 Height = 30
Top = 184 Top = 264
Width = 224 Width = 224
Caption = 'Connect' Caption = 'Connect'
OnClick = btnConnectClick OnClick = btnConnectClick
TabOrder = 2 TabOrder = 1
end
object Label10: TLabel
Left = 8
Height = 17
Top = 48
Width = 170
Caption = 'Please choose how to play:'
ParentColor = False
end end
end end
object pageConnecting: TPage object pageConnecting: TPage
ClientWidth = 1424 ClientWidth = 11520
ClientHeight = 1620 ClientHeight = 13856
object Label4: TLabel object Label4: TLabel
Left = 0 Left = 0
Height = 32 Height = 32
@ -245,8 +236,8 @@ object formChess: TformChess
end end
end end
object pageGame: TPage object pageGame: TPage
ClientWidth = 360 ClientWidth = 11520
ClientHeight = 433 ClientHeight = 13856
object Label5: TLabel object Label5: TLabel
Left = 0 Left = 0
Height = 32 Height = 32
@ -277,8 +268,8 @@ object formChess: TformChess
end end
end end
object pageWebservice: TPage object pageWebservice: TPage
ClientWidth = 1424 ClientWidth = 11520
ClientHeight = 1620 ClientHeight = 13856
object Label8: TLabel object Label8: TLabel
Left = 0 Left = 0
Height = 32 Height = 32
@ -301,10 +292,10 @@ object formChess: TformChess
EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = editPlayerName EditLabel.AnchorSideRight.Control = editPlayerName
EditLabel.AnchorSideBottom.Control = editPlayerName EditLabel.AnchorSideBottom.Control = editPlayerName
EditLabel.Left = 6 EditLabel.Left = -1062
EditLabel.Height = 15 EditLabel.Height = 17
EditLabel.Top = 75 EditLabel.Top = 75
EditLabel.Width = 75 EditLabel.Width = 79
EditLabel.Caption = 'Player Name' EditLabel.Caption = 'Player Name'
EditLabel.ParentColor = False EditLabel.ParentColor = False
LabelPosition = lpLeft LabelPosition = lpLeft

View File

@ -7,10 +7,9 @@ interface
uses uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, ComCtrls, StdCtrls, Buttons, Spin, ExtCtrls, ComCtrls, StdCtrls, Buttons, Spin,
// // fpchess
IDelphiChess_Intf, chessdrawer, chessgame, chessconfig, chesstcputils,
// chessmodules;
chessdrawer, chessgame, chessconfig, chesstcputils;
type type
@ -29,16 +28,15 @@ type
TformChess = class(TForm) TformChess = class(TForm)
btnConnect: TBitBtn; btnConnect: TBitBtn;
btnAI: TBitBtn;
btnSinglePlayer: TBitBtn;
btnDirectComm: TBitBtn;
BitBtn3: TBitBtn; BitBtn3: TBitBtn;
btnHotSeat: TBitBtn;
btnPlayAgainstAI: TButton; btnPlayAgainstAI: TButton;
checkTimer: TCheckBox; checkTimer: TCheckBox;
comboGameMode: TComboBox;
comboStartColor: TComboBox; comboStartColor: TComboBox;
editLocalIP: TLabeledEdit;
editWebserviceURL: TLabeledEdit; editWebserviceURL: TLabeledEdit;
Label1: TLabel; Label1: TLabel;
Label10: TLabel;
labelTime: TLabel; labelTime: TLabel;
Label2: TLabel; Label2: TLabel;
Label3: TLabel; Label3: TLabel;
@ -51,12 +49,12 @@ type
editWebServiceAI: TLabeledEdit; editWebServiceAI: TLabeledEdit;
labelPos: TLabel; labelPos: TLabel;
editRemoteID: TLabeledEdit; editRemoteID: TLabeledEdit;
editLocalIP: TLabeledEdit;
editPlayerName: TLabeledEdit; editPlayerName: TLabeledEdit;
pageStart: TPage; pageStart: TPage;
pageConfigConnection: TPage; pageConfigureGame: TPage;
notebookMain: TNotebook; notebookMain: TNotebook;
pageConnecting: TPage; pageConnecting: TPage;
panelModules: TPanel;
ProgressBar1: TProgressBar; ProgressBar1: TProgressBar;
pageGame: TPage; pageGame: TPage;
spinPlayerTime: TSpinEdit; spinPlayerTime: TSpinEdit;
@ -64,13 +62,13 @@ type
pageWebservice: TPage; pageWebservice: TPage;
procedure btnConnectClick(Sender: TObject); procedure btnConnectClick(Sender: TObject);
procedure btnPlayAgainstAIClick(Sender: TObject); procedure btnPlayAgainstAIClick(Sender: TObject);
procedure comboGameModeSelect(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure HandleMainScreenButton(Sender: TObject);
procedure pageBeforeShow(Sender: TObject; ANewPage: TPage; ANewIndex: Integer);
procedure timerChessTimerTimer(Sender: TObject); procedure timerChessTimerTimer(Sender: TObject);
private private
{ private declarations } { private declarations }
function FormatTime(ATimeInMiliseconds: Integer): string; function FormatTime(ATimeInMiliseconds: Integer): string;
procedure UpdateChessModulesUI(ANewIndex: Integer);
public public
{ public declarations } { public declarations }
procedure UpdateCaptions; procedure UpdateCaptions;
@ -87,37 +85,13 @@ implementation
const const
INT_PAGE_START = 0; INT_PAGE_START = 0;
INT_PAGE_CONFIGCONNECTION = 1; INT_PAGE_CONFIGUREGAME = 1;
INT_PAGE_CONNECTING = 2; INT_PAGE_CONNECTING = 2;
INT_PAGE_GAME = 3; INT_PAGE_GAME = 3;
INT_PAGE_AI = 4; INT_PAGE_AI = 4;
{ TformChess } { TformChess }
procedure TformChess.HandleMainScreenButton(Sender: TObject);
begin
if Sender = btnSinglePlayer then
begin
notebookMain.PageIndex := INT_PAGE_GAME;
InitializeGameModel();
end
else if Sender = btnHotSeat then
begin
notebookMain.PageIndex := INT_PAGE_GAME;
InitializeGameModel();
end
else if Sender = btnDirectComm then notebookMain.PageIndex := INT_PAGE_CONFIGCONNECTION
else if Sender = btnAI then notebookMain.PageIndex := INT_PAGE_AI;
end;
procedure TformChess.pageBeforeShow(Sender: TObject; ANewPage: TPage; ANewIndex: Integer);
begin
if ANewIndex = INT_PAGE_CONFIGCONNECTION then
begin
editLocalIP.Text := ChessGetLocalIP();
end;
end;
procedure TformChess.timerChessTimerTimer(Sender: TObject); procedure TformChess.timerChessTimerTimer(Sender: TObject);
begin begin
vChessGame.UpdateTimes(); vChessGame.UpdateTimes();
@ -149,6 +123,17 @@ begin
Result := Result + IntToStr(lTimePart); Result := Result + IntToStr(lTimePart);
end; end;
procedure TformChess.UpdateChessModulesUI(ANewIndex: Integer);
var
lModule: TChessModule;
begin
if ANewIndex = gSelectedModuleIndex then Exit;
lModule := GetChessModule(gSelectedModuleIndex);
if lModule <> nil then lModule.FreeUserInterface();
GetChessModule(ANewIndex).ShowUserInterface(panelModules);
end;
procedure TformChess.UpdateCaptions; procedure TformChess.UpdateCaptions;
var var
lStr: string; lStr: string;
@ -185,6 +170,16 @@ begin
// Loading of resources // Loading of resources
vChessDrawer.LoadImages(); vChessDrawer.LoadImages();
// Prepare the modules view
InitializeGameModel();
editLocalIP.Text := ChessGetLocalIP();
PopulateChessModulesList(comboGameMode.Items);
if GetChessModuleCount() >= 1 then
begin
comboGameMode.ItemIndex := 0;
UpdateChessModulesUI(0);
end;
end; end;
procedure TformChess.btnConnectClick(Sender: TObject); procedure TformChess.btnConnectClick(Sender: TObject);
@ -199,8 +194,14 @@ begin
notebookMain.PageIndex := INT_PAGE_GAME; notebookMain.PageIndex := INT_PAGE_GAME;
if comboStartColor.ItemIndex = 0 then // if comboStartColor.ItemIndex = 0 then
GetNextMoveFromBorlandWS(); // GetNextMoveFromBorlandWS();
end;
procedure TformChess.comboGameModeSelect(Sender: TObject);
begin
UpdateChessModulesUI(comboGameMode.ItemIndex);
gSelectedModuleIndex := comboGameMode.ItemIndex;
end; end;
{ TFormDrawerDelegate } { TFormDrawerDelegate }

View File

@ -0,0 +1,73 @@
unit mod_singleplayer;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
StdCtrls, Forms, Controls,
chessmodules;
type
{ TSinglePlayerChessModule }
TSinglePlayerChessModule = class(TChessModule)
private
textSecondPlayerName: TStaticText;
editSecondPlayerName: TEdit;
public
SecondPlayerName: string;
constructor Create();
procedure CreateUserInterface(); override;
procedure ShowUserInterface(AParent: TWinControl); override;
procedure HideUserInterface(); override;
procedure FreeUserInterface(); override;
end;
implementation
{ TSinglePlayerChessModule }
constructor TSinglePlayerChessModule.Create;
begin
inherited Create;
Description := 'Play against a friend in the same computer';
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;
initialization
RegisterChessModule(TSinglePlayerChessModule.Create);
end.