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

fpchess: Advances the telnet code to communicate with fics

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1903 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-09-06 06:20:37 +00:00
parent 1998ad3bf8
commit 8ce0f66b60
4 changed files with 147 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
applications/fpchess/fpchess.lpi
View File

@ -68,7 +68,7 @@
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="16">
<Units Count="17">
<Unit0>
<Filename Value="fpchess.lpr"/>
<IsPartOfProject Value="True"/>
@ -151,6 +151,11 @@
<ResourceBaseClass Value="Form"/>
<UnitName Value="selectPromotionPiece"/>
</Unit15>
<Unit16>
<Filename Value="ltelnetex.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ltelnetex"/>
</Unit16>
</Units>
</ProjectOptions>
<CompilerOptions>

2
applications/fpchess/fpchess.lpr
View File

@ -9,7 +9,7 @@ uses
Interfaces, // this includes the LCL widgetset
Forms, lnetbase, mainform, chessdrawer, chessgame, chessconfig,
chesstcputils, chessmodules, mod_samecomputer, mod_fics, mod_kcchess,
selectPromotionPiece
selectPromotionPiece, ltelnetex
{$ifdef FPCHESS_WEBSERVICES}
,IDelphiChess_Intf
{$endif};

79
applications/fpchess/ltelnetex.pas Normal file
View File

@ -0,0 +1,79 @@
unit ltelnetex;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
lTelnet, lnet,
sorokinregexpr,
Forms;
type
TLTelnetDebugOutProc = procedure (AStr: string) of object;
{ TLTelnetClientEx }
TLTelnetClientEx = class(TLTelnetClient)
private
FOnDebugOut: TLTelnetDebugOutProc;
RegexObj: TRegExpr;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
function WaitFor(FirstMatch, SecondMatch: string; ATimeOut: Cardinal): Integer;
property OnDebugOut: TLTelnetDebugOutProc read FOnDebugOut write FOnDebugOut;
end;
implementation
{ TLTelnetClientEx }
constructor TLTelnetClientEx.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
RegexObj := TRegExpr.Create;
end;
destructor TLTelnetClientEx.Destroy;
begin
RegexObj.Free;
inherited Destroy;
end;
{ Returns a zero-based index to which regular expression was found
or -1 if none was found
}
function TLTelnetClientEx.WaitFor(FirstMatch, SecondMatch: string;
ATimeOut: Cardinal): Integer;
var
lMsg: string;
begin
Result := -1;
if (FirstMatch = '') and (SecondMatch = '') then Exit;
while True do
begin
if GetMessage(lMsg) > 0 then if Assigned(OnDebugOut) then OnDebugOut(lMsg);
if FirstMatch <> '' then
begin
RegexObj.Expression := FirstMatch;
if RegexObj.Exec(lMsg) then Exit(0);
end;
if SecondMatch <> '' then
begin
RegexObj.Expression := SecondMatch;
if RegexObj.Exec(lMsg) then Exit(1);
end;
CallAction; // don't forget to make the clock tick :)
Application.ProcessMessages;
Sleep(100);
end;
end;
end.

93
applications/fpchess/mod_fics.pas
View File

@ -16,8 +16,8 @@ interface
uses
Classes, SysUtils,
StdCtrls, Forms, Controls,
lTelnet, lnet,
sorokinregexpr, // Remove when FPC 2.8 comes with this
lTelnetex, lnet,
sorokinregexpr, // Rename to regexpr when FPC 2.8 comes with this
chessmodules, chessgame;
type
@ -27,14 +27,13 @@ type
TFICSChessModule = class(TChessModule)
public
SecondPlayerName: string;
TelnetComm: TLTelnetClient;
TelnetComm: TLTelnetClientEx;
FICS_HOST: string;
FICS_PORT: Integer;
FICS_USER: string;
FICS_PASSWORD: string;
// Frequency to issue commands to avoid disconnection, in miliseconds
PROTECT_LOGOUT_FREQ: Integer;
RegexObj: TRegExpr;
constructor Create(); override;
destructor Destroy; override;
procedure CreateUserInterface(); override;
@ -44,8 +43,13 @@ type
procedure PrepareForGame(); override;
function GetSecondPlayerName(): string; override;
procedure HandleOnMove(AFrom, ATo: TPoint); override;
procedure HandleOnDebugOut(AStr: string);
end;
const
FICS_LineEnding = #10;
OPEN_TIMEOUT = 10000;
implementation
{ TFICSChessModule }
@ -54,9 +58,8 @@ constructor TFICSChessModule.Create;
begin
inherited Create;
RegexObj := TRegExpr.Create;
TelnetComm := TLTelnetClient.Create(nil);
TelnetComm := TLTelnetClientEx.Create(nil);
TelnetComm.OnDebugOut := @HandleOnDebugOut;
(* $telnet = new Net::Telnet(
Timeout => $OPEN_TIMEOUT,
Binmode => 1,
@ -70,7 +73,7 @@ begin
FICS_HOST := 'freechess.org';
FICS_PORT := 5000;
FICS_USER := 'BotTutorial';
FICS_USER := 'FPChess';
FICS_PASSWORD := '';
PROTECT_LOGOUT_FREQ := 45 * 60 * 1000;
end;
@ -78,7 +81,6 @@ end;
destructor TFICSChessModule.Destroy;
begin
TelnetComm.Free;
RegexObj.Free;
inherited Destroy;
end;
@ -123,7 +125,6 @@ begin
// Opening telnet connection. This is what happens when you issue telnet freechess.org 5000.
lResult := TelnetComm.Connect(FICS_HOST, FICS_PORT);
if not lResult then
begin
ChessModuleDebugLn('Failed to connect to FICS');
@ -132,8 +133,8 @@ begin
repeat
TelnetComm.CallAction; // repeat this to get info
// if KeyPressed then
// Halt;
Application.ProcessMessages;
Sleep(10);
until TelnetComm.Connected; // wait until timeout or we actualy connected
ChessModuleDebugLn('Connected to FICS');
@ -156,44 +157,39 @@ begin
$telnet->print($FICS_USER);
}
WaitTerminated := False;
while not WaitTerminated do
begin
if TelnetComm.GetMessage(lMsg) > 0 then
ChessModuleDebugOut(lMsg);
TelnetComm.WaitFor(
'.*login:.*',
'.*username:.*',
OPEN_TIMEOUT);
RegexObj.Expression := '/login[: ]*$/i';
// ... and we send our username once prompted.
//ChessModuleDebugLn('Found the login!!!');
TelnetComm.SendMessage(FICS_USER + FICS_LineEnding);
if RegexObj.Exec(lMsg) then WaitTerminated := True;
// Now we read obtained lines scanning for some patterns.
TelnetComm.WaitFor(
'.*Press return to enter.*',
'',
OPEN_TIMEOUT);
TelnetComm.SendMessage(FICS_LineEnding);
TelnetComm.CallAction; // don't forget to make the clock tick :)
Application.ProcessMessages;
Sleep(100);
end;
ChessModuleDebugLn('Found the login!!!');
end;
(*
... and we send our username once prompted. Now we read obtained lines scanning for some patterns.
while (1) {
my $line = $telnet->getline(Timeout => $LINE_WAIT_TIMEOUT);
next if $line =~ /^[\s\r\n]*$/;
if ($line =~ /Press return to enter/) {
$telnet->print();
last;
}
Normal guest login here. We get Press return to enter suggestion and we do exactly that (we send empty line).
if ($line =~ /("[^"]*" is a registered name|\S+ is already logged in)/) {
(*if ($line =~ /("[^"]*" is a registered name|\S+ is already logged in)/) {
die "Can not login as $FICS_USER: $1\n";
}
Bad luck, we picked the name used by somebody, it is not possible to login as guest with this nick.
print STDERR "Ignored line: $line\n" if $VERBOSE;
}
*)
Developing-helper note and the end of loop. We get further after last breaks the loop above.
(*
After accepting guest login we may face two things.
First, FICS may accept our login and send us a message like
Starting FICS session as BotTutorial.
This means everything is OK and we can go on.
Alternatively, FICS may notice another guest using the same name,
in such case it will tell us something like BotTutorial is already
logged in and will disconnect.
print STDERR "Successfully logged as guest $username\n" if $VERBOSE;
my($pre, $match) = $telnet->waitfor(
Match => "/Starting FICS session as ([a-zA-Z0-9]+)/",
Match => "/\\S+ is already logged in/",
@ -204,11 +200,13 @@ begin
else {
die "Can not login as $FICS_USER: $match\n";
}
After accepting guest login we may face two things. First, FICS may accept our login and send us a message like Starting FICS session as BotTutorial. This means everything is OK and we can go on. Alternatively, FICS may notice another guest using the same name, in such case it will tell us something like BotTutorial is already logged in and will disconnect.
print STDERR "Successfully logged as guest $username\n" if $VERBOSE;
}
*)
TelnetComm.WaitFor(
'.*Starting FICS session as.*',
'',
OPEN_TIMEOUT);
end;
end;
function TFICSChessModule.GetSecondPlayerName: string;
@ -223,6 +221,11 @@ begin
end;
procedure TFICSChessModule.HandleOnDebugOut(AStr: string);
begin
ChessModuleDebugOut(AStr);
end;
initialization
RegisterChessModule(TFICSChessModule.Create);
end.