pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpchess: FICS playing now works =)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1906 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-09-06 12:24:08 +00:00
parent 73811c895f
commit f59a8e2941
7 changed files with 66 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
applications/fpchess/chessdrawer.pas
View File

@ -94,9 +94,12 @@ var
X, Y, SourceX, SourceY, DestX, DestY: integer; X, Y, SourceX, SourceY, DestX, DestY: integer;
dx, dy: Integer; dx, dy: Integer;
t: Double; t: Double;
lTile: TChessTile;
begin begin
// Draw the moving tile // Draw the moving tile
lTileBmp := vChessDrawer.GetChessTileImage(vChessGame.Board[AFrom.X][AFrom.Y]); //WriteLn(Format('[TChessMoveAnimation.DrawToIntfImg] Afrom=%d,%d', [AFrom.X, AFrom.Y]));
lTile := vChessGame.Board[AFrom.X][AFrom.Y];
lTileBmp := vChessDrawer.GetChessTileImage(lTile);
if lTileBmp = nil then Exit; if lTileBmp = nil then Exit;
SourceX := (AFrom.X - 1) * INT_CHESSTILE_SIZE; SourceX := (AFrom.X - 1) * INT_CHESSTILE_SIZE;

34
applications/fpchess/chessgame.pas
View File

@ -96,6 +96,7 @@ type
Dragging: Boolean; Dragging: Boolean;
DragStart, MouseMovePos: TPoint; DragStart, MouseMovePos: TPoint;
UseTimer: Boolean; UseTimer: Boolean;
Enabled: Boolean;
WhitePlayerTime: Integer; // milisseconds WhitePlayerTime: Integer; // milisseconds
BlackPlayerTime: Integer; // milisseconds BlackPlayerTime: Integer; // milisseconds
MoveStartTime: TDateTime; MoveStartTime: TDateTime;
@ -119,7 +120,7 @@ type
function ClientToBoardCoords(AClientCoords: TPoint): TPoint; function ClientToBoardCoords(AClientCoords: TPoint): TPoint;
class function BoardPosToChessCoords(APos: TPoint): string; class function BoardPosToChessCoords(APos: TPoint): string;
class function ChessCoordsToBoardPos(AStr: string): TPoint; class function ChessCoordsToBoardPos(AStr: string): TPoint;
class procedure ChessMoveCoordsToBoardPos(AMoveStr: string; AFrom, ATo: TPoint); class procedure ChessMoveCoordsToBoardPos(AMoveStr: string; var AFrom, ATo: TPoint);
class function ColumnNumToLetter(ACol: Integer): string; class function ColumnNumToLetter(ACol: Integer): string;
function CheckStartMove(AFrom: TPoint): Boolean; function CheckStartMove(AFrom: TPoint): Boolean;
function CheckEndMove(ATo: TPoint): Boolean; function CheckEndMove(ATo: TPoint): Boolean;
@ -156,6 +157,7 @@ var
i: Integer; i: Integer;
j: Integer; j: Integer;
begin begin
Enabled := True;
UseTimer := AUseTimer; UseTimer := AUseTimer;
FirstPlayerIsWhite := APlayAsWhite; FirstPlayerIsWhite := APlayAsWhite;
IsWhitePlayerTurn := True; IsWhitePlayerTurn := True;
@ -169,21 +171,11 @@ begin
IsBlackLeftRoquePossible := True; IsBlackLeftRoquePossible := True;
IsBlackRightRoquePossible := True; IsBlackRightRoquePossible := True;
// // Don't invert these, instead invert only in the drawer
if APlayAsWhite then lWPawnRow := 2;
begin lWMainRow := 1;
lWPawnRow := 2; lBPawnRow := 7;
lWMainRow := 1; lBMainRow := 8;
lBPawnRow := 7;
lBMainRow := 8;
end
else
begin
lWPawnRow := 7;
lWMainRow := 8;
lBPawnRow := 2;
lBMainRow := 1;
end;
// First, clear the board // First, clear the board
for i := 1 to 8 do for i := 1 to 8 do
@ -758,15 +750,19 @@ begin
Result.Y := StrToInt(lStr); Result.Y := StrToInt(lStr);
end; end;
class procedure TChessGame.ChessMoveCoordsToBoardPos(AMoveStr: string; AFrom, class procedure TChessGame.ChessMoveCoordsToBoardPos(AMoveStr: string;
ATo: TPoint); var AFrom, ATo: TPoint);
var var
lStr: String; lStr: String;
begin begin
WriteLn('[TChessGame.ChessMoveCoordsToBoardPos] ' + AMoveStr);
lStr := Copy(AMoveStr, 1, 2); lStr := Copy(AMoveStr, 1, 2);
///WriteLn('[TChessGame.ChessMoveCoordsToBoardPos] ' + lStr);
AFrom := TChessGame.ChessCoordsToBoardPos(lStr); AFrom := TChessGame.ChessCoordsToBoardPos(lStr);
lStr := Copy(AMoveStr, 3, 2); lStr := Copy(AMoveStr, 4, 2);
//WriteLn('[TChessGame.ChessMoveCoordsToBoardPos] ' + lStr);
ATo := TChessGame.ChessCoordsToBoardPos(lStr); ATo := TChessGame.ChessCoordsToBoardPos(lStr);
WriteLn(Format('[TChessGame.ChessMoveCoordsToBoardPos] AFrom.X=%d,%d ATo=%d,%d', [AFrom.X, AFrom.Y, ATo.X, ATo.Y]));
end; end;
class function TChessGame.ColumnNumToLetter(ACol: Integer): string; class function TChessGame.ColumnNumToLetter(ACol: Integer): string;

3
applications/fpchess/chessmodules.pas
View File

@ -116,7 +116,8 @@ end;
function TChessModule.IsMovingAllowedNow: Boolean; function TChessModule.IsMovingAllowedNow: Boolean;
begin begin
Result := not (vChessGame.IsWhitePlayerTurn xor vChessGame.FirstPlayerIsWhite); Result := (not (vChessGame.IsWhitePlayerTurn xor vChessGame.FirstPlayerIsWhite))
and (vChessGame.Enabled);
end; end;
procedure TChessModule.HandleOnTimer; procedure TChessModule.HandleOnTimer;

3
applications/fpchess/ltelnetex.pas
View File

@ -57,7 +57,8 @@ begin
if (FirstMatch = '') and (SecondMatch = '') then Exit; if (FirstMatch = '') and (SecondMatch = '') then Exit;
repeat repeat
if GetMessage(lMsg) > 0 then if Assigned(OnDebugOut) then OnDebugOut(lMsg); if GetMessage(lMsg) > 0 then
if Assigned(OnDebugOut) then OnDebugOut(lMsg);
LastMsg := lMsg; LastMsg := lMsg;

42
applications/fpchess/mainform.lfm
View File

@ -45,17 +45,17 @@ object formChess: TformChess
end end
object Label6: TLabel object Label6: TLabel
Left = 28 Left = 28
Height = 17 Height = 18
Top = 128 Top = 128
Width = 52 Width = 56
Caption = 'Start as:' Caption = 'Start as:'
ParentColor = False ParentColor = False
end end
object Label7: TLabel object Label7: TLabel
Left = 80 Left = 80
Height = 17 Height = 18
Top = 175 Top = 175
Width = 150 Width = 152
Caption = 'minutes for each player' Caption = 'minutes for each player'
ParentColor = False ParentColor = False
end end
@ -70,7 +70,7 @@ object formChess: TformChess
end end
object editPlayerName: TLabeledEdit object editPlayerName: TLabeledEdit
Left = 88 Left = 88
Height = 22 Height = 25
Top = 104 Top = 104
Width = 120 Width = 120
EditLabel.AnchorSideLeft.Control = editPlayerName EditLabel.AnchorSideLeft.Control = editPlayerName
@ -78,10 +78,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 = 2
EditLabel.Height = 17 EditLabel.Height = 18
EditLabel.Top = 107 EditLabel.Top = 107
EditLabel.Width = 79 EditLabel.Width = 83
EditLabel.Caption = 'Player Name' EditLabel.Caption = 'Player Name'
EditLabel.ParentColor = False EditLabel.ParentColor = False
LabelPosition = lpLeft LabelPosition = lpLeft
@ -89,7 +89,7 @@ object formChess: TformChess
end end
object comboStartColor: TComboBox object comboStartColor: TComboBox
Left = 88 Left = 88
Height = 21 Height = 27
Top = 128 Top = 128
Width = 120 Width = 120
ItemHeight = 0 ItemHeight = 0
@ -103,9 +103,9 @@ object formChess: TformChess
end end
object checkTimer: TCheckBox object checkTimer: TCheckBox
Left = 24 Left = 24
Height = 18 Height = 21
Top = 152 Top = 152
Width = 212 Width = 220
Caption = 'Set a time limit for each Player' Caption = 'Set a time limit for each Player'
Checked = True Checked = True
State = cbChecked State = cbChecked
@ -113,7 +113,7 @@ object formChess: TformChess
end end
object spinPlayerTime: TSpinEdit object spinPlayerTime: TSpinEdit
Left = 21 Left = 21
Height = 16 Height = 25
Top = 176 Top = 176
Width = 50 Width = 50
TabOrder = 4 TabOrder = 4
@ -121,7 +121,7 @@ object formChess: TformChess
end end
object comboGameMode: TComboBox object comboGameMode: TComboBox
Left = 8 Left = 8
Height = 21 Height = 27
Top = 74 Top = 74
Width = 346 Width = 346
ItemHeight = 0 ItemHeight = 0
@ -140,7 +140,7 @@ object formChess: TformChess
end end
object editLocalIP: TLabeledEdit object editLocalIP: TLabeledEdit
Left = 120 Left = 120
Height = 22 Height = 25
Top = 200 Top = 200
Width = 120 Width = 120
EditLabel.AnchorSideLeft.Control = editLocalIP EditLabel.AnchorSideLeft.Control = editLocalIP
@ -148,10 +148,10 @@ object formChess: TformChess
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 = 12 EditLabel.Left = 15
EditLabel.Height = 17 EditLabel.Height = 18
EditLabel.Top = 203 EditLabel.Top = 203
EditLabel.Width = 105 EditLabel.Width = 102
EditLabel.Caption = 'Your IP Address:' EditLabel.Caption = 'Your IP Address:'
EditLabel.ParentColor = False EditLabel.ParentColor = False
LabelPosition = lpLeft LabelPosition = lpLeft
@ -169,8 +169,8 @@ object formChess: TformChess
end end
end end
object pageGame: TPage object pageGame: TPage
ClientWidth = 720 ClientWidth = 1440
ClientHeight = 1000 ClientHeight = 2000
object labelPos: TLabel object labelPos: TLabel
Left = 8 Left = 8
Height = 18 Height = 18
@ -238,8 +238,8 @@ object formChess: TformChess
end end
end end
object pageWebservice: TPage object pageWebservice: TPage
ClientWidth = 11520 ClientWidth = 23040
ClientHeight = 13856 ClientHeight = 27712
object Label8: TLabel object Label8: TLabel
Left = 0 Left = 0
Height = 32 Height = 32

3
applications/fpchess/mainform.pas
View File

@ -241,6 +241,7 @@ var
lModule: TChessModule; lModule: TChessModule;
begin begin
InitializeGameModel(); InitializeGameModel();
vChessGame.Enabled := False;
notebookMain.PageIndex := INT_PAGE_GAME; notebookMain.PageIndex := INT_PAGE_GAME;
@ -249,6 +250,8 @@ begin
vChessGame.PlayerName := editPlayerName.Text; vChessGame.PlayerName := editPlayerName.Text;
lModule.PrepareForGame(); lModule.PrepareForGame();
// Make sure this is done after lModule.PrepareForGame()
vChessGame.Enabled := True;
timerChessTimer.Enabled := True; timerChessTimer.Enabled := True;
end; end;

24
applications/fpchess/mod_fics.pas
View File

@ -97,6 +97,7 @@ begin
radioConnectionType.Caption := 'FICS Connection Type'; radioConnectionType.Caption := 'FICS Connection Type';
radioConnectionType.Items.Add('Wait for a friend to connect to me'); radioConnectionType.Items.Add('Wait for a friend to connect to me');
radioConnectionType.Items.Add('Connect to a friend (he needs to be waiting for the connection)'); radioConnectionType.Items.Add('Connect to a friend (he needs to be waiting for the connection)');
radioConnectionType.ItemIndex := 0;
textPassword := TStaticText.Create(nil); textPassword := TStaticText.Create(nil);
textPassword.SetBounds(10, 110, 180, 20); textPassword.SetBounds(10, 110, 180, 20);
@ -112,7 +113,7 @@ begin
editSecondPlayerName := TEdit.Create(nil); editSecondPlayerName := TEdit.Create(nil);
editSecondPlayerName.SetBounds(200, 130, 150, 40); editSecondPlayerName.SetBounds(200, 130, 150, 40);
editSecondPlayerName.Text := ''; editSecondPlayerName.Text := 'fpchesse';
end; end;
procedure TFICSChessModule.ShowUserInterface(AParent: TWinControl); procedure TFICSChessModule.ShowUserInterface(AParent: TWinControl);
@ -195,6 +196,7 @@ begin
// ... and we send our username once prompted. // ... and we send our username once prompted.
//ChessModuleDebugLn('Found the login!!!'); //ChessModuleDebugLn('Found the login!!!');
ChessModuleDebugLn('Sending: ' + FICS_USER);
TelnetComm.SendMessage(FICS_USER + FICS_LineEnding); TelnetComm.SendMessage(FICS_USER + FICS_LineEnding);
// Now we read obtained lines scanning for some patterns. // Now we read obtained lines scanning for some patterns.
@ -244,6 +246,7 @@ begin
'.*fics%.*', '.*fics%.*',
'', '',
OPEN_TIMEOUT); OPEN_TIMEOUT);
ChessModuleDebugLn('Sending: set seek 0');
TelnetComm.SendMessage('set seek 0' + FICS_LineEnding); TelnetComm.SendMessage('set seek 0' + FICS_LineEnding);
// Set the style // Set the style
@ -251,18 +254,22 @@ begin
'.*fics%.*', '.*fics%.*',
'', '',
OPEN_TIMEOUT); OPEN_TIMEOUT);
ChessModuleDebugLn('Sending: set style 11');
TelnetComm.SendMessage('set style 11' + FICS_LineEnding); TelnetComm.SendMessage('set style 11' + FICS_LineEnding);
// Wait for a match // Wait for a match
if radioConnectionType.ItemIndex = 0 then if radioConnectionType.ItemIndex = 0 then
begin begin
vChessGame.FirstPlayerIsWhite := False;
// Challenge: GuestZMYL (----) fpchess (----) unrated blitz 2 12. // Challenge: GuestZMYL (----) fpchess (----) unrated blitz 2 12.
// You can "accept" or "decline", or propose different parameters. // You can "accept" or "decline", or propose different parameters.
TelnetComm.WaitFor( TelnetComm.WaitFor(
'.*You can "accept" or "decline", or propose different parameters*', '.*You can "accept" or "decline", or propose different parameters*',
'', '',
OPEN_TIMEOUT); OPEN_TIMEOUT);
TelnetComm.SendMessage('accept ' + FICS_LineEnding); ChessModuleDebugLn('Sending: accept');
TelnetComm.SendMessage('accept' + FICS_LineEnding);
// You accept the match offer from GuestZMYL. // You accept the match offer from GuestZMYL.
TelnetComm.WaitFor( TelnetComm.WaitFor(
@ -277,7 +284,9 @@ begin
'.*fics%.*', '.*fics%.*',
'', '',
OPEN_TIMEOUT); OPEN_TIMEOUT);
TelnetComm.SendMessage('match ' + editSecondPlayerName.Text + FICS_LineEnding); lMsg := 'match ' + editSecondPlayerName.Text + ' 60 White';
ChessModuleDebugLn('Sending: ' + lMsg);
TelnetComm.SendMessage(lMsg + FICS_LineEnding);
// fpchess accepts the match offer. // fpchess accepts the match offer.
TelnetComm.WaitFor( TelnetComm.WaitFor(
@ -299,11 +308,14 @@ var
lMsg: String; lMsg: String;
begin begin
lMsg := Format('%s-%s', [TChessGame.BoardPosToChessCoords(AFrom), TChessGame.BoardPosToChessCoords(ATo)]); lMsg := Format('%s-%s', [TChessGame.BoardPosToChessCoords(AFrom), TChessGame.BoardPosToChessCoords(ATo)]);
ChessModuleDebugLn('Sending: ' + lMsg);
TelnetComm.SendMessage(lMsg + FICS_LineEnding);
// Wait until it shows our move
TelnetComm.WaitFor( TelnetComm.WaitFor(
'.*fics%.*', '.*[PRNBQK]/[abcdefgh][0123456789]-[abcdefgh][0123456789].*',
'', '',
OPEN_TIMEOUT); OPEN_TIMEOUT);
TelnetComm.SendMessage(lMsg + FICS_LineEnding);
end; end;
// listen for moves // listen for moves
@ -321,6 +333,8 @@ begin
'.*[PRNBQK]/[abcdefgh][0123456789]-[abcdefgh][0123456789].*', '.*[PRNBQK]/[abcdefgh][0123456789]-[abcdefgh][0123456789].*',
'', '',
0); 0);
// if TelnetComm.LastMsg <> '' then
// lIndex := lIndex;
if lIndex = 0 then if lIndex = 0 then
begin begin
lMoveStr := Copy(TelnetComm.LastMsg, Pos('/', TelnetComm.LastMsg)+1, 5); lMoveStr := Copy(TelnetComm.LastMsg, Pos('/', TelnetComm.LastMsg)+1, 5);