unit UNetwork;
{ ********************************************************************************* }
{ (c) GNU                                                                           }
{ author: Heiko Tietze                                                              }
{ version: 1.0                                                                      }
{ date: 11.12.2004                                                                  }
{ description: network operations; one server and up to 4 clients take part in a    }
{              game, where the server has a client too; all communication is sent   }
{              to the server and broadcastet to the clients (even the chat);        }
{              a connection is established after a handshake; the definition of the }
{              message type is done in UTools.pas                                   }
{ ********************************************************************************* }

{$I Def.inc}

interface

uses SysUtils, Classes, Variants, IniFiles, Types,
     IdThreadMgr, IdThreadMgrDefault, IdTCPConnection, IdTCPClient, IdBaseComponent, IdComponent, IdTCPServer,
     {$IFDEF VCL}
     Windows, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls,
     {$ELSE}
     QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls, QComCtrls,
     {$ENDIF}
     UTools, UGameOptions, ULanguage;

type TNetMsg = record //WriteBuffer()
                 Command      : TNetMsgType;//TNetMsgType -> UTools
                 msg          : ShortString;
                 Sender, Recipient : Byte;
               end;
     TClientThread = class(TThread)
               private
                  FClient : TidTCPClient;       //read from this client
                  FNetMsg : TNetMsg;            //read to this buffer
                  FOnReceive : TNetworkMessage; //associated with network.onreceive
               protected
                  procedure Execute; override;
                  procedure SynchMessage;
                  property OnReceive : TNetworkMessage read FOnReceive write FOnReceive;
               end;
     PClient=^TClient;
     TClient=record
               DNS    : String[20];
               Name   : String[20];
               ID     : Byte;
               Thread : Pointer;
             end;
     TNetwork=class(TForm)
             btnOK          : TButton;
             btnCancel      : TButton;
             edServer       : TEdit;
             gbName         : TGroupBox;
             edName         : TEdit;
             rgServerClient : TRadioGroup;
             TCPClient      : TIdTCPClient;
             TCPServer      : TIdTCPServer;
             ThreadManager  : TIdThreadMgrDefault;
             procedure FormCreate(Sender: TObject);
             procedure FormDestroy(Sender: TObject);
             procedure rgServerClientClick(Sender: TObject);
             procedure btnOKClick(Sender: TObject);
             procedure TCPServerConnect(AThread: TIdPeerThread);
             procedure TCPServerDisconnect(AThread: TIdPeerThread);
             procedure TCPServerExecute(AThread: TIdPeerThread);
             procedure TCPClientConnected(Sender: TObject);
             procedure TCPClientDisconnected(Sender: TObject);
           private
             FOnReceive    : TNetworkMessage;
             FLocalPlayer  : Byte;
             FClientThread : TClientThread;
             FClients      : TThreadList;
             FClientCount  : Byte;
           public
             procedure OnSendMessage(NetMsgType:TNetMsgType; Sender, Recipient : Byte; Value:string);
             property OnReceive:TNetworkMessage read FOnReceive write FOnReceive;
             property LocalPlayer : Byte read FLocalPlayer write FLocalPlayer;
           end;

var Network  : TNetwork;

implementation

{$IFDEF VCL}
  {$R *.dfm}
{$ELSE}
  {$R *.xfm}
{$ENDIF}

{ TClientThread }

procedure TClientThread.Execute;
begin
  while not Terminated do
  try
    FClient.ReadBuffer(FNetMsg,SizeOf(TNetMsg));
    Synchronize(SynchMessage);
  except
  end;
end;

procedure TClientThread.SynchMessage;
begin
  if assigned(FOnReceive) then FOnReceive(FNetMsg.Command,FNetMsg.Sender,FNetMsg.Recipient,FNetMsg.msg);
end;

{ TNetwork }

procedure TNetwork.FormCreate(Sender: TObject);
begin
   rgServerClient.Caption:=Language.Translate[rgServerClient.Caption];
   gbName.Caption:=Language.Translate[gbName.Caption];
   with TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) do
   try
     edServer.Text:=ReadString('Network','LastConnection','127.0.0.1');
     {$IFDEF VCl} edName.Text:=ReadString('Network','PlayerName',UserName+'@'+ComputerName);{$ENDIF}
   finally
     Free;
   end;
   FClientCount:=0;
   FLocalPlayer:=255;
end;

procedure TNetwork.FormDestroy(Sender: TObject);
const ServerClose:TNetMsg=(Command:nmServerDisconnect;msg:'Server disconnected, end of network game';Sender:0;Recipient:0);
var Receiver : PClient;
    i:integer;
    NetMsg : TNetMsg;
begin
   with TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) do
   try
     WriteString('Network','LastConnection',edServer.Text);
     WriteString('Network','PlayerName',edName.Text);
   finally
     Free;
   end;
   //inform all clients to close (except the local client)
   if TCPServer.Active then
   begin
     with FClients.LockList do //recipient=255 -> broadcast message
     try
       for i:=1 to Count-1 do
       begin
         Receiver:=Items[i];
         NetMsg:=ServerClose;
         NetMsg.msg:=Language.Translate[NetMsg.msg];
         TidPeerThread(Receiver.Thread).Connection.WriteBuffer(NetMsg, SizeOf(TNetMsg), true);
       end;
     finally
       FClients.UnlockList;
     end;
     TCPClient.DisconnectSocket; //server should close his own client not due to a message
     TCPServer.Active:=false;
   end else TCPClient.DisconnectSocket;
   FClients.Free;
   if assigned(FClientThread) then FClientThread.Terminate;
end;

procedure TNetwork.rgServerClientClick(Sender: TObject);
begin
   edServer.Enabled:=(rgServerClient.ItemIndex=1);
end;

procedure TNetwork.btnOKClick(Sender: TObject);
begin
   try
     if rgServerClient.ItemIndex=0 then
     begin
        TCPServer.DefaultPort:=StrToInt(GameOptions.edPort.Text);
        TCPServer.Active:=true;
        FClients:=TThreadList.Create;
     end;
     try //the server application has a client too
        TCPClient.Port:=StrToInt(GameOptions.edPort.Text);
        if rgServerClient.ItemIndex=0 then TCPClient.Host:='localhost'
                                      else TCPClient.Host:=edServer.Text;
        FClientThread:=TClientThread.Create(true);
        FClientThread.OnReceive:=self.OnReceive;
        FClientThread.FClient:=TCPClient;
        FClientThread.FreeOnTerminate:=true;
        FClientThread.Resume;
        TCPClient.Connect(10000);
     except
       on E: Exception do MessageDlg(Language.Translate['Error while connecting:']+#13#10+E.Message, mtError, [mbOk], 0);
     end;
   except
     ModalResult:=mrAbort;
   end;
end;

procedure TNetwork.TCPServerConnect(aThread: TIdPeerThread);
const TooMuchPlayers:TNetMsg=(Command:nmServerDisconnect;msg:'Too much players';Sender:0;Recipient:0);
var NewClient: PClient;
    NetMsg : TNetMsg;
begin
  if FClientCount<4 then
  begin
    GetMem(NewClient, SizeOf(TClient));
    NewClient.DNS:=aThread.Connection.LocalName;
    NewClient.Thread:=aThread;
    NewClient.Name:='';
    NewClient.ID:=FClientCount;
    inc(FClientCount);
    aThread.Data:=TObject(NewClient);
    try
      FClients.LockList.Add(NewClient);
    finally
      FClients.UnlockList;
    end;
  end else
  begin
    NetMsg:=TooMuchPlayers;
    NetMsg.msg:=Language.Translate[NetMsg.msg];
    aThread.Connection.WriteBuffer(NetMsg,sizeof(TNetMsg));
    aThread.Connection.Disconnect;
  end;
end;

procedure TNetwork.TCPServerDisconnect(AThread: TIdPeerThread);
var Client : PClient;
    NetMsg : TNetMsg;
    i      : Integer;
begin
  Client:=PClient(aThread.Data);
  if Client<>nil then //client is not set in case of TooMuchPlayers
  begin
    with FClients.LockList do
    try
      Remove(Client);
    finally
      FClients.UnlockList;
    end;
    FreeMem(Client);
    aThread.Data:=nil;
    dec(FClientCount);
    NetMsg.msg:=Client.Name+' '+Language.Translate['closed connection'];
    with FClients.LockList do //recipient=255 -> broadcast message
    try
      for i:=0 to Count-1 do
      begin
        Client:=Items[i];
        Client.ID:=i;
        NetMsg.Command:=nmClientDisconnect;
        NetMsg.Recipient:=Client.ID;
        NetMsg.Sender:=0;
        TidPeerThread(Client.Thread).Connection.WriteBuffer(NetMsg, SizeOf(TNetMsg), true);
      end;
    finally
      FClients.UnlockList;
    end;
  end;
end;

procedure TNetwork.TCPServerExecute(aThread: TIdPeerThread);
var Receiver : PClient;
    NetMsg   : TNetMsg;
    i        : Integer;
begin
  if not aThread.Terminated and aThread.Connection.Connected then
  begin
    aThread.Connection.ReadBuffer(NetMsg,SizeOf(TNetMsg));
    case NetMsg.Command of
      nmConnect : begin //handshake answer
                    NetMsg.Sender:=PClient(aThread.Data).ID;
                    PClient(aThread.Data).Name:=NetMsg.msg;
                  end;
      nmNewGame : begin
                    NetMsg.msg:=chr(GameOptions.sgLetters.RowCount);
                    for i:=1 to GameOptions.sgLetters.RowCount-1 do
                        NetMsg.msg:=NetMsg.msg+GameOptions.sgLetters.Cells[0,i]+
                                    chr(StrToIntDef(GameOptions.sgLetters.Cells[1,i],1))+
                                    chr(StrToIntDef(GameOptions.sgLetters.Cells[2,i],1));
                    Randomize;
                    NetMsg.msg:=NetMsg.msg+chr(Random(999)+1);
                    NetMsg.msg:=NetMsg.msg+chr(StrToIntDef(GameOptions.edLetterCount.Text,7))+
                                           chr(integer(GameOptions.cbDoubleFirstMove.Checked)+1);
                    with FClients.LockList do
                    try
                       for i:=0 to Count-1 do
                          NetMsg.msg:=NetMsg.msg+chr(length(PClient(Items[i]).Name))+PClient(Items[i]).Name;
                    finally
                       FClients.UnlockList;
                    end;
                  end;
    end;
    with FClients.LockList do //recipient=255 -> broadcast message
    try
      for i:=0 to Count-1 do
      begin
        Receiver:=Items[i];
        if (NetMsg.Recipient=255) or (Receiver.ID=NetMsg.Recipient) then
        begin
           TidPeerThread(Receiver.Thread).Connection.WriteBuffer(NetMsg, SizeOf(TNetMsg), true);
        end;
      end;
    finally
      FClients.UnlockList;
    end;
  end;
end;

procedure TNetwork.TCPClientConnected(Sender: TObject);
begin
  OnSendMessage(nmConnect,0,255,edName.Text); //initiate handshake
end;

procedure TNetwork.TCPClientDisconnected(Sender: TObject);
begin
  if assigned(FOnReceive) then FOnReceive(nmServerDisconnect,0,0,Language.Translate['Connection to server adjourned']);
end;

procedure TNetwork.OnSendMessage(NetMsgType: TNetMsgType; Sender, Recipient: Byte; Value: string);
var tmp:TNetMsg;
begin
  tmp.Command:=NetMsgType;
  tmp.Sender:=FLocalPlayer;
  tmp.Recipient:=Recipient;
  tmp.msg:=Value;
  TCPClient.WriteBuffer(tmp,sizeof(TNetMsg),false);
end;

end.
