diff --git a/applications/fpchess/chessgame.pas b/applications/fpchess/chessgame.pas index 47693382a..ee128e2b9 100644 --- a/applications/fpchess/chessgame.pas +++ b/applications/fpchess/chessgame.pas @@ -116,8 +116,10 @@ type 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 ColumnNumToLetter(ACol: Integer): string; + class function BoardPosToChessCoords(APos: TPoint): string; + class function ChessCoordsToBoardPos(AStr: string): TPoint; + class procedure ChessMoveCoordsToBoardPos(AMoveStr: string; AFrom, ATo: TPoint); + class function ColumnNumToLetter(ACol: Integer): string; function CheckStartMove(AFrom: TPoint): Boolean; function CheckEndMove(ATo: TPoint): Boolean; function FindKing(): TPoint; @@ -735,7 +737,7 @@ begin Result.Y := 1 + (INT_CHESSBOARD_SIZE - AClientCoords.Y) div INT_CHESSTILE_SIZE; end; -function TChessGame.BoardPosToChessCoords(APos: TPoint): string; +class function TChessGame.BoardPosToChessCoords(APos: TPoint): string; var lStr: string; begin @@ -743,7 +745,30 @@ begin Result := Format('%s%d', [lStr, APos.Y]); end; -function TChessGame.ColumnNumToLetter(ACol: Integer): string; +class function TChessGame.ChessCoordsToBoardPos(AStr: string): TPoint; +var + lStr: string; +begin + if Length(AStr) < 2 then raise Exception.Create('[TChessGame.ChessCoordsToBoardPos] Length(AStr) < 2'); + lStr := Copy(AStr, 1, 1); + lStr := LowerCase(lStr); + Result.X := Byte(lStr[1]) - 96; + lStr := Copy(AStr, 2, 1); + Result.Y := StrToInt(lStr); +end; + +class procedure TChessGame.ChessMoveCoordsToBoardPos(AMoveStr: string; AFrom, + ATo: TPoint); +var + lStr: String; +begin + lStr := Copy(AMoveStr, 1, 2); + AFrom := TChessGame.ChessCoordsToBoardPos(lStr); + lStr := Copy(AMoveStr, 3, 2); + ATo := TChessGame.ChessCoordsToBoardPos(lStr); +end; + +class function TChessGame.ColumnNumToLetter(ACol: Integer): string; begin Result := Char(ACol + 96); end; diff --git a/applications/fpchess/chessmodules.pas b/applications/fpchess/chessmodules.pas index 9f5a311f8..636baede9 100644 --- a/applications/fpchess/chessmodules.pas +++ b/applications/fpchess/chessmodules.pas @@ -27,6 +27,7 @@ type function IsMovingAllowedNow(): Boolean; virtual; function GetSecondPlayerName(): string; virtual; abstract; procedure HandleOnMove(AFrom, ATo: TPoint); virtual; abstract; + procedure HandleOnTimer(); virtual; end; var @@ -36,6 +37,7 @@ var procedure RegisterChessModule(AModule: TChessModule); procedure PopulateChessModulesList(AList: TStrings); function GetChessModule(AIndex: Integer): TChessModule; +function GetCurrentChessModule: TChessModule; function GetChessModuleCount(): Integer; procedure ChessModuleDebugLn(AStr: string); procedure ChessModuleDebugOut(AStr: string); @@ -83,6 +85,11 @@ begin Result := TChessModule(gChessModules.Items[AIndex]); end; +function GetCurrentChessModule: TChessModule; +begin + Result := GetChessModule(gSelectedModuleIndex); +end; + function GetChessModuleCount: Integer; begin Result := gChessModules.Count; @@ -112,6 +119,11 @@ begin Result := not (vChessGame.IsWhitePlayerTurn xor vChessGame.FirstPlayerIsWhite); end; +procedure TChessModule.HandleOnTimer; +begin + +end; + initialization gChessModules := TList.Create; vChessGame.OnAfterMove := @HandleOnMove; diff --git a/applications/fpchess/ltelnetex.pas b/applications/fpchess/ltelnetex.pas index 15ae97292..8808a0c7c 100644 --- a/applications/fpchess/ltelnetex.pas +++ b/applications/fpchess/ltelnetex.pas @@ -20,6 +20,7 @@ type FOnDebugOut: TLTelnetDebugOutProc; RegexObj: TRegExpr; public + LastMsg: string; constructor Create(aOwner: TComponent); override; destructor Destroy; override; function WaitFor(FirstMatch, SecondMatch: string; ATimeOut: Cardinal): Integer; @@ -49,14 +50,17 @@ function TLTelnetClientEx.WaitFor(FirstMatch, SecondMatch: string; ATimeOut: Cardinal): Integer; var lMsg: string; + lRemaining: Integer; begin + lRemaining := ATimeOut; Result := -1; if (FirstMatch = '') and (SecondMatch = '') then Exit; - while True do - begin + repeat if GetMessage(lMsg) > 0 then if Assigned(OnDebugOut) then OnDebugOut(lMsg); + LastMsg := lMsg; + if FirstMatch <> '' then begin RegexObj.Expression := FirstMatch; @@ -70,9 +74,13 @@ begin end; CallAction; // don't forget to make the clock tick :) - Application.ProcessMessages; - Sleep(100); - end; + if lRemaining > 0 then // Don't sleep if the routine was called with ATimeOut=0 + begin + Application.ProcessMessages; + Sleep(100); + end; + Dec(lRemaining, 100); + until lRemaining <= 0; end; end. diff --git a/applications/fpchess/mainform.pas b/applications/fpchess/mainform.pas index e71612e4d..6e3aea4e5 100644 --- a/applications/fpchess/mainform.pas +++ b/applications/fpchess/mainform.pas @@ -99,6 +99,7 @@ begin vChessGame.UpdateTimes(); UpdateCaptions(); vChessDrawer.HandleOnTimer(Sender); + GetCurrentChessModule().HandleOnTimer(); end; function TformChess.FormatTime(ATimeInMiliseconds: Integer): string; diff --git a/applications/fpchess/mod_fics.pas b/applications/fpchess/mod_fics.pas index 5e3170acb..bf80b764c 100644 --- a/applications/fpchess/mod_fics.pas +++ b/applications/fpchess/mod_fics.pas @@ -15,16 +15,22 @@ interface uses Classes, SysUtils, - StdCtrls, Forms, Controls, + StdCtrls, Forms, Controls, ExtCtrls, maskedit, lTelnetex, lnet, sorokinregexpr, // Rename to regexpr when FPC 2.8 comes with this - chessmodules, chessgame; + chessmodules, chessgame, chessdrawer; type { TFICSChessModule } TFICSChessModule = class(TChessModule) + private + radioConnectionType: TRadioGroup; + textPassword: TStaticText; + editPassword: TMaskEdit; + textSecondPlayerName: TStaticText; + editSecondPlayerName: TEdit; public SecondPlayerName: string; TelnetComm: TLTelnetClientEx; @@ -32,8 +38,6 @@ type FICS_PORT: Integer; FICS_USER: string; FICS_PASSWORD: string; - // Frequency to issue commands to avoid disconnection, in miliseconds - PROTECT_LOGOUT_FREQ: Integer; constructor Create(); override; destructor Destroy; override; procedure CreateUserInterface(); override; @@ -43,12 +47,14 @@ type procedure PrepareForGame(); override; function GetSecondPlayerName(): string; override; procedure HandleOnMove(AFrom, ATo: TPoint); override; + procedure HandleOnTimer(); override; procedure HandleOnDebugOut(AStr: string); end; const FICS_LineEnding = #10; - OPEN_TIMEOUT = 10000; + OPEN_TIMEOUT = 1000000; + PROTECT_LOGOUT_FREQ = 45 * 60 * 1000; // Frequency to issue commands to avoid disconnection, in miliseconds implementation @@ -75,7 +81,6 @@ begin FICS_PORT := 5000; FICS_USER := 'FPChess'; FICS_PASSWORD := ''; - PROTECT_LOGOUT_FREQ := 45 * 60 * 1000; end; destructor TFICSChessModule.Destroy; @@ -87,31 +92,54 @@ end; procedure TFICSChessModule.CreateUserInterface; begin -{ textSecondPlayerName := TStaticText.Create(nil); - textSecondPlayerName.SetBounds(20, 20, 180, 50); - textSecondPlayerName.Caption := 'Name of the second player'; + radioConnectionType := TRadioGroup.Create(nil); + radioConnectionType.SetBounds(10, 10, 300, 100); + radioConnectionType.Caption := 'FICS Connection Type'; + 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)'); + + textPassword := TStaticText.Create(nil); + textPassword.SetBounds(10, 110, 180, 20); + textPassword.Caption := 'Your FICS Password'; + + editPassword := TMaskEdit.Create(nil); + editPassword.SetBounds(200, 110, 150, 20); + editPassword.Text := ''; + + textSecondPlayerName := TStaticText.Create(nil); + textSecondPlayerName.SetBounds(10, 130, 180, 40); + textSecondPlayerName.Caption := 'FICS Login of the other player'; editSecondPlayerName := TEdit.Create(nil); - editSecondPlayerName.SetBounds(200, 20, 150, 50); - editSecondPlayerName.Text := 'Second player';} + editSecondPlayerName.SetBounds(200, 130, 150, 40); + editSecondPlayerName.Text := ''; end; procedure TFICSChessModule.ShowUserInterface(AParent: TWinControl); begin -{ textSecondPlayerName.Parent := AParent; - editSecondPlayerName.Parent := AParent;} + radioConnectionType.Parent := AParent; + textPassword.Parent := AParent; + editPassword.Parent := AParent; + textSecondPlayerName.Parent := AParent; + editSecondPlayerName.Parent := AParent; end; procedure TFICSChessModule.HideUserInterface(); begin -{ textSecondPlayerName.Parent := nil; - editSecondPlayerName.Parent := nil;} + radioConnectionType.Parent := nil; + textPassword.Parent := nil; + editPassword.Parent := nil; + textSecondPlayerName.Parent := nil; + editSecondPlayerName.Parent := nil; end; procedure TFICSChessModule.FreeUserInterface; begin -{ textSecondPlayerName.Free; - editSecondPlayerName.Free;} + radioConnectionType.Free; + textPassword.Free; + editPassword.Free; + textSecondPlayerName.Free; + editSecondPlayerName.Free; end; procedure TFICSChessModule.PrepareForGame; @@ -119,6 +147,9 @@ var lResult, WaitTerminated: Boolean; lMsg: string; begin + FICS_USER := 'FPChess'; + FICS_PASSWORD := editPassword.Text; + // SecondPlayerName := editSecondPlayerName.Text; ChessModuleDebugLn('[TFICSChessModule.PrepareForGame]'); @@ -207,6 +238,53 @@ begin '', OPEN_TIMEOUT); end; + + // Remove those annoying message of people seeking chess adversaries + TelnetComm.WaitFor( + '.*fics%.*', + '', + OPEN_TIMEOUT); + TelnetComm.SendMessage('set seek 0' + FICS_LineEnding); + + // Set the style + TelnetComm.WaitFor( + '.*fics%.*', + '', + OPEN_TIMEOUT); + TelnetComm.SendMessage('set style 11' + FICS_LineEnding); + + // Wait for a match + if radioConnectionType.ItemIndex = 0 then + begin + // Challenge: GuestZMYL (----) fpchess (----) unrated blitz 2 12. + // You can "accept" or "decline", or propose different parameters. + TelnetComm.WaitFor( + '.*You can "accept" or "decline", or propose different parameters*', + '', + OPEN_TIMEOUT); + TelnetComm.SendMessage('accept ' + FICS_LineEnding); + + // You accept the match offer from GuestZMYL. + TelnetComm.WaitFor( + '.*You accept the match offer from*', + '', + OPEN_TIMEOUT); + end + // Challenge a partner + else + begin + TelnetComm.WaitFor( + '.*fics%.*', + '', + OPEN_TIMEOUT); + TelnetComm.SendMessage('match ' + editSecondPlayerName.Text + FICS_LineEnding); + + // fpchess accepts the match offer. + TelnetComm.WaitFor( + '.*accepts the match offer*', + '', + OPEN_TIMEOUT); + end; end; function TFICSChessModule.GetSecondPlayerName: string; @@ -215,10 +293,43 @@ begin end; // If a move came, it is because the local player did a move -// so send this move and start listening for a move +// so send this move procedure TFICSChessModule.HandleOnMove(AFrom, ATo: TPoint); +var + lMsg: String; begin + lMsg := Format('%s-%s', [TChessGame.BoardPosToChessCoords(AFrom), TChessGame.BoardPosToChessCoords(ATo)]); + TelnetComm.WaitFor( + '.*fics%.*', + '', + OPEN_TIMEOUT); + TelnetComm.SendMessage(lMsg + FICS_LineEnding); +end; +// listen for moves +procedure TFICSChessModule.HandleOnTimer; +var + lIndex: Integer; + lAnimation: TChessMoveAnimation; + lFrom, lTo: TPoint; + lMoveStr: String; +begin + // Example output in style 11 + // #@#086GuestZMYL :fpchess *RNBQKBNR PPP PP P PP p p ppp ppprnbqkbnr003B3939-1628-0163P/a2-a4(1:03)@#@ + + lIndex := TelnetComm.WaitFor( + '.*[PRNBQK]/[abcdefgh][0123456789]-[abcdefgh][0123456789].*', + '', + 0); + if lIndex = 0 then + begin + lMoveStr := Copy(TelnetComm.LastMsg, Pos('/', TelnetComm.LastMsg)+1, 5); + TChessGame.ChessMoveCoordsToBoardPos(lMoveStr, lFrom, lTo); + lAnimation := TChessMoveAnimation.Create; + lAnimation.AFrom := lFrom; + lAnimation.ATo := lTo; + vChessDrawer.AddAnimation(lAnimation); + end; end; procedure TFICSChessModule.HandleOnDebugOut(AStr: string);