source: tags/1.4.0/GameServer.pas

unit GameServer;

interface

uses
  Classes, SysUtils, Game, DOM, XMLConf, Generics.Collections, GameProtocol,
  CommFrame, Player;

type
  TServerMode = (smLocal, smNetworkServer, smNetworkClient);

  { TServerClient }

  TServerClient = class
  private
    procedure DoTurnEnd(Sender: TObject);
    procedure DoSurrender(Sender: TObject);
  public
    Game: TGame;
    Protocol: TGameProtocolServer;
    Player: TPlayer;
    CommFrame: TCommFrame;
    procedure DoChange;
    procedure TurnStart;
    procedure GameEnd;
    procedure NextPlayer;
    constructor Create;
    destructor Destroy; override;
  end;

  { TServerClients }

  TServerClients = class(TObjectList<TServerClient>)
    Game: TGame;
    function SearchByPlayer(Player: TPlayer): TServerClient;
  end;

  { TServer }

  TServer = class
  private
    FActive: Boolean;
    FGame: TGame;
    FServerMode: TServerMode;
    procedure SetActive(AValue: Boolean);
    procedure SetGame(AValue: TGame);
    procedure SetServerMode(AValue: TServerMode);
    procedure GameStarted(Sender: TObject);
  public
    Clients: TServerClients;
    LocalNetworkAddress: string;
    LocalNetworkPort: Word;
    RemoteNetworkAddress: string;
    RemoteNetworkPort: Word;
    procedure DoChange(Sender: TObject);
    function GetNewServerClient: TServerClient;
    procedure LoadConfig(Config: TXmlConfig; Path: string);
    procedure SaveConfig(Config: TXmlConfig; Path: string);
    procedure InitClients;
    procedure GameEnd;
    procedure NextPlayer;
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TServer);
    property Game: TGame read FGame write SetGame;
    property Mode: TServerMode read FServerMode write SetServerMode;
    property Active: Boolean read FActive write SetActive;
  end;

const
  DefaultServerPort = 40009;


implementation

{ TServerClients }

function TServerClients.SearchByPlayer(Player: TPlayer): TServerClient;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].Player <> Player) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

{ TServerClient }

procedure TServerClient.DoChange;
begin
  Protocol.ParametersChanged;
end;

procedure TServerClient.TurnStart;
begin
  Protocol.TurnStart;
end;

procedure TServerClient.GameEnd;
begin
  Protocol.GameEnd;
end;

procedure TServerClient.NextPlayer;
begin
  Protocol.NextPlayer;
end;

constructor TServerClient.Create;
begin
  CommFrame := TCommFrame.Create(nil);
  Protocol := TGameProtocolServer.Create;
  Protocol.OnTurnEnd := DoTurnEnd;
  Protocol.OnSurrender := DoSurrender;
  Protocol.Pin.Connect(CommFrame.FrameDataPin);
end;

destructor TServerClient.Destroy;
begin
  FreeAndNil(Protocol);
  FreeAndNil(CommFrame);
  inherited;
end;

procedure TServerClient.DoTurnEnd(Sender: TObject);
begin
  if Game.Running then Game.NextPlayer;
end;

procedure TServerClient.DoSurrender(Sender: TObject);
begin
  Player.Surrender;
  if Game.Running then Game.NextPlayer;
end;

{ TServer }

procedure TServer.SetGame(AValue: TGame);
var
  I: Integer;
begin
  if FGame = AValue then Exit;
  if Assigned(FGame) then
    FGame.OnChange := nil;
  FGame := AValue;
  for I := 0 to Clients.Count - 1 do
    Clients[I].Game := FGame;
  Clients.Game := Game;
  if Assigned(FGame) then
    FGame.OnChange := DoChange;
end;

procedure TServer.SetActive(AValue: Boolean);
begin
  if FActive = AValue then Exit;
  FActive := AValue;
end;

procedure TServer.SetServerMode(AValue: TServerMode);
var
  LastActiveState: Boolean;
begin
  if FServerMode = AValue then Exit;
  LastActiveState := Active;
  Active := False;
  FServerMode := AValue;
{  FreeAndNil(GameSocket);
  case FServerMode of
    smLocal: GameSocket := TGameSocketDirect.Create;
    smNetworkServer: begin
      GameSocket := TGameSocketNetworkServer.Create;
      TGameSocketNetworkServer(GameSocket).TCPServer.Address := LocalNetworkAddress;
      TGameSocketNetworkServer(GameSocket).TCPServer.Port := LocalNetworkPort;
      //TODO TGameSocketNetworkServer(GameSocket).TCPServer.Active := True;
    end;
    smNetworkClient: begin
      GameSocket := TGameSocketNetworkClient.Create;
      if (LocalNetworkAddress = RemoteNetworkAddress) and
        (LocalNetworkPort = RemoteNetworkPort) then begin
          // User wants to play on its own server
          GameSocket := TGameSocketNetworkServer.Create;
          TGameSocketNetworkServer(GameSocket).TCPServer.Address := LocalNetworkAddress;
          TGameSocketNetworkServer(GameSocket).TCPServer.Port := LocalNetworkPort;
          //TODO TGameSocketNetworkServer(GameSocket).TCPServer.Active := True;
        end else
        begin
          // Do not create socket. User wants to connect elsewhere
        end;
      end;
  end;
  }
  Active := LastActiveState;
end;

procedure TServer.DoChange(Sender: TObject);
var
  Client: TServerClient;
begin
  for Client in Clients do
    Client.DoChange;
end;

procedure TServer.GameStarted(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to Clients.Count - 1 do
  with TServerClient(Clients[I]) do begin
    //TODO View.Clear;
  end;
end;

function TServer.GetNewServerClient: TServerClient;
begin
  Result := TServerClient.Create;
  Result.Game := Game;
  Clients.Add(Result);
end;

procedure TServer.LoadConfig(Config: TXmlConfig; Path: string);
begin
  with Config do begin
    LocalNetworkAddress := string(GetValue(DOMString(Path + '/LocalNetworkAddress'), 'localhost'));
    LocalNetworkPort := GetValue(DOMString(Path + '/LocalNetworkPort'), DefaultServerPort);
    RemoteNetworkAddress := string(GetValue(DOMString(Path + '/RemoteNetworkAddress'), 'localhost'));
    RemoteNetworkPort := GetValue(DOMString(Path + '/RemoteNetworkPort'), DefaultServerPort);
    Mode := TServerMode(GetValue(DOMString(Path + '/Mode'), Integer(smLocal)));
  end;
end;

procedure TServer.SaveConfig(Config: TXmlConfig; Path: string);
begin
  with Config do begin
    SetValue(DOMString(Path + '/LocalNetworkAddress'), DOMString(LocalNetworkAddress));
    SetValue(DOMString(Path + '/LocalNetworkPort'), LocalNetworkPort);
    SetValue(DOMString(Path + '/RemoteNetworkAddress'), DOMString(RemoteNetworkAddress));
    SetValue(DOMString(Path + '/RemoteNetworkPort'), RemoteNetworkPort);
    SetValue(DOMString(Path + '/Mode'), Integer(Mode));
  end;
end;

procedure TServer.InitClients;
begin
  Clients.Clear;
end;

procedure TServer.GameEnd;
var
  I: Integer;
begin
  for I := 0 to Clients.Count - 1 do
    Clients[I].GameEnd;
end;

procedure TServer.NextPlayer;
var
  I: Integer;
begin
  for I := 0 to Clients.Count - 1 do
    Clients[I].NextPlayer;
end;

procedure TServer.Clear;
begin
  Clients.Clear;
  Game.Clear;
end;

constructor TServer.Create;
begin
  FGame := nil;
  Clients := TServerClients.Create;
end;

destructor TServer.Destroy;
begin
  FreeAndNil(Clients);
  inherited;
end;

procedure TServer.Assign(Source: TServer);
begin
  Mode := Source.Mode;
  Game := Source.Game;
  LocalNetworkAddress := Source.LocalNetworkAddress;
  LocalNetworkPort := Source.LocalNetworkPort;
  RemoteNetworkAddress := Source.RemoteNetworkAddress;
  RemoteNetworkPort := Source.RemoteNetworkPort;
  //Active := Source.Active;
end;

end.