fpchess: Fixes a crash and start implementing the telnet code

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1846 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat 2011-08-27 21:49:44 +00:00
parent de135f4ea0
commit 0a26a629ff
3 changed files with 107 additions and 4 deletions

View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
Controls, Controls, StdCtrls,
chessgame; chessgame;
type type
@ -28,7 +28,7 @@ type
var var
gSelectedModuleIndex: Integer = -1; gSelectedModuleIndex: Integer = -1;
gChessModulesDebugOutputDestiny: TStrings = nil; gChessModulesDebugOutputDestiny: TMemo = nil;
procedure RegisterChessModule(AModule: TChessModule); procedure RegisterChessModule(AModule: TChessModule);
procedure PopulateChessModulesList(AList: TStrings); procedure PopulateChessModulesList(AList: TStrings);
@ -84,7 +84,7 @@ end;
procedure ChessModuleDebugLn(AStr: string); procedure ChessModuleDebugLn(AStr: string);
begin begin
if Assigned(gChessModulesDebugOutputDestiny) then if Assigned(gChessModulesDebugOutputDestiny) then
gChessModulesDebugOutputDestiny.Add(AStr); gChessModulesDebugOutputDestiny.Lines.Add(AStr);
end; end;
initialization initialization

View File

@ -173,7 +173,7 @@ begin
UpdateChessModulesUI(0); UpdateChessModulesUI(0);
gSelectedModuleIndex := 0; gSelectedModuleIndex := 0;
end; end;
gChessModulesDebugOutputDestiny := memoDebug.Lines; gChessModulesDebugOutputDestiny := memoDebug;
end; end;
procedure TformChess.btnQuitClick(Sender: TObject); procedure TformChess.btnQuitClick(Sender: TObject);

View File

@ -16,6 +16,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
StdCtrls, Forms, Controls, StdCtrls, Forms, Controls,
lTelnet,
chessmodules, chessgame; chessmodules, chessgame;
type type
@ -25,7 +26,15 @@ type
TFICSChessModule = class(TChessModule) TFICSChessModule = class(TChessModule)
public public
SecondPlayerName: string; SecondPlayerName: string;
TelnetComm: TLTelnetClient;
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;
constructor Create(); constructor Create();
destructor Destroy; override;
procedure CreateUserInterface(); override; procedure CreateUserInterface(); override;
procedure ShowUserInterface(AParent: TWinControl); override; procedure ShowUserInterface(AParent: TWinControl); override;
procedure HideUserInterface(); override; procedure HideUserInterface(); override;
@ -44,8 +53,28 @@ constructor TFICSChessModule.Create;
begin begin
inherited Create; inherited Create;
TelnetComm := TLTelnetClient.Create(nil);
(* $telnet = new Net::Telnet(
Timeout => $OPEN_TIMEOUT,
Binmode => 1,
Errmode => 'die',
);*)
Description := 'Play online via the Free Internet Chess Server'; Description := 'Play online via the Free Internet Chess Server';
Kind := cmkSinglePlayer; Kind := cmkSinglePlayer;
FICS_HOST := 'freechess.org';
FICS_PORT := 5000;
FICS_USER := 'BotTutorial';
FICS_PASSWORD := '';
PROTECT_LOGOUT_FREQ := 45 * 60 * 1000;
end;
destructor TFICSChessModule.Destroy;
begin
TelnetComm.Free;
inherited Destroy;
end; end;
procedure TFICSChessModule.CreateUserInterface; procedure TFICSChessModule.CreateUserInterface;
@ -78,9 +107,83 @@ begin
end; end;
procedure TFICSChessModule.PrepareForGame; procedure TFICSChessModule.PrepareForGame;
var
lResult: Boolean;
begin begin
// SecondPlayerName := editSecondPlayerName.Text; // SecondPlayerName := editSecondPlayerName.Text;
ChessModuleDebugLn('[TFICSChessModule.PrepareForGame]'); ChessModuleDebugLn('[TFICSChessModule.PrepareForGame]');
// 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');
Exit;
// print STDERR "\n" if $VERBOSE;
end;
ChessModuleDebugLn('Connected to FICS');
// If $FICS_PASSWORD is given, we peform normal full login (give username and password). FICS is standard enough to have Net::Telnet::login routine perform this process properly.
if FICS_PASSWORD <> '' then
begin
//$telnet->login(Name => $FICS_USER, Password => $FICS_PASSWORD);
// $username = $FICS_USER;
// print STDERR "Successfully logged as user $FICS_USER\n" if $VERBOSE;
end
else
begin
end;
(*
Now let's go to the guest login. Again, try logging to FICS via telnet as guest to understand what we are testing for here.
else {
$telnet->waitfor(
Match => '/login[: ]*$/i',
Match => '/username[: ]*$/i',
Timeout => $OPEN_TIMEOUT);
$telnet->print($FICS_USER);
... 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)/) {
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.
my($pre, $match) = $telnet->waitfor(
Match => "/Starting FICS session as ([a-zA-Z0-9]+)/",
Match => "/\\S+ is already logged in/",
Timeout => $OPEN_TIMEOUT);
if ( $match =~ /Starting FICS session as ([a-zA-Z0-9]+)/ ) {
$username = $1;
}
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;
}
*)
end; end;
function TFICSChessModule.IsMovingAllowedNow: Boolean; function TFICSChessModule.IsMovingAllowedNow: Boolean;