ChivalryServerLauncher/source/model/Game.Chivalry.pas

unit Game.Chivalry;

interface
uses
  System.Generics.Collections,

  Game.Base,
  Game.Intf;


type
  TChivalryGame = class(TCustomGame, IGameNetwork, IGameName, IGameMapList)
  private
    FServerPort: Integer;
    FPeerPort: Integer;
    FQueryPort: Integer;

    FServerName: string;
    FMessageOfTheDay: string;

    FPredefinedMapList: TObjectList<TGameMap>;
    FMapList: TObjectList<TGameMap>;
  protected
    procedure DoLoad; override;
    procedure DoSave; override;

    procedure LoadPredefinedMapList(AList: TList<TGameMap>); virtual; abstract;

    function CreateGameMap(const AMapName: string): TGameMap; virtual;
  public
    constructor Create(const ALocation: string); override;
    destructor Destroy; override;

    function GetExecutable: string; override;
    function GetParameters: string; override;

    { IGameNetwork }
    function GetServerPort: Integer;
    function GetPeerPort: Integer;
    function GetQueryPort: Integer;

    procedure SetServerPort(const Value: Integer);
    procedure SetPeerPort(const Value: Integer);
    procedure SetQueryPort(const Value: Integer);

    property ServerPort: Integer read GetServerPort write SetServerPort;
    property PeerPort: Integer read GetPeerPort write SetPeerPort;
    property QueryPort: Integer read GetQueryPort write SetQueryPort;

    { IGameName }
    function GetServerName: string;
    function GetMessageOfTheDay: string;

    procedure SetServerName(const Value: string);
    procedure SetMessageOfTheDay(const Value: string);

    property ServerName: string read GetServerName write SetServerName;
    property MessageOfTheDay: string read GetMessageOfTheDay write SetMessageOfTheDay;

    { IGameMapList }
    function GetPredefinedMapList: TEnumerable<TGameMap>;
    function GetMapList: TEnumerable<TGameMap>;

    function GetMapCount: Integer;
    function GetMap(Index: Integer): TGameMap;

    procedure AddMap(AMap: TGameMap);
    procedure InsertMap(Index: Integer; AMap: TGameMap);
    procedure DeleteMap(AIndex: Integer);
    procedure RemoveMap(AMap: TGameMap);
    procedure MoveMap(ASourceIndex, ATargetIndex: Integer);

    property PredefinedMapList: TEnumerable<TGameMap> read GetPredefinedMapList;
    property MapList: TEnumerable<TGameMap> read GetMapList;
    property MapCount: Integer read GetMapCount;
    property Map[Index: Integer]: TGameMap read GetMap;
  end;


implementation
uses
  System.Classes,
  System.IniFiles,
  System.SysUtils,

  Winapi.Windows,

  UDKIniFile;


const
  GameSettingsFileName = 'UDKGame\Config\PCServer-UDKGame.ini';
    GameURL = 'URL';
      GameURLPort = 'Port';                   GameURLPortDefault = 7777;
      GameURLPeerPort = 'PeerPort';           GameURLPeerPortDefault = 7778;

    GameReplicationInfo = 'Engine.GameReplicationInfo';
      GameReplicationInfoServerName = 'ServerName';
      GameReplicationInfoMessageOfTheDay = 'MessageOfTheDay';

    GameAOCGame = 'AOC.AOCGame';
      GameAOCGameMapList = 'Maplist';


  EngineSettingsFileName = 'UDKGame\Config\PCServer-UDKEngine.ini';
    EngineSteam = 'OnlineSubsystemSteamworks.OnlineSubsystemSteamworks';
      EngineSteamQueryPort = 'QueryPort';     EngineSteamQueryPortDefault = 27015;




{ TChivalryGame }
constructor TChivalryGame.Create(const ALocation: string);
begin
  inherited Create(ALocation);

  FPredefinedMapList := TObjectList<TGameMap>.Create(True);
  FMapList := TObjectList<TGameMap>.Create(True);

  LoadPredefinedMapList(FPredefinedMapList);
end;


destructor TChivalryGame.Destroy;
begin
  FreeAndNil(FMapList);
  FreeAndNil(FPredefinedMapList);

  inherited Destroy;
end;


function TChivalryGame.GetExecutable: string;
var
  isWow64: BOOL;
  bits: string;

begin
  {$IFDEF WIN64}
  bits := 'Win64';
  {$ELSE}
  if IsWow64Process(GetCurrentProcess, isWow64) and isWow64 then
    bits := 'Win64'
  else
    bits := 'Win32';
  {$ENDIF}

  Result := Location + 'Binaries\' + bits + '\UDKLogging.exe';
end;


function TChivalryGame.GetParameters: string;
begin
  // #ToDo1 -oMvR: 2-7-2014: check how changing the starting map influences the map list,
  //                         that could make selecting the starting map possible.
  //                         Otherwise, a starting map option would need to shuffle the
  //                         map list a bit.
  if MapCount = 0 then
    raise Exception.Create('Please add at least one map to the map list');

  Result := Map[0].Name + '?steamsockets -dedicated=true -seekfreeloadingserver';
end;


procedure TChivalryGame.DoLoad;
var
  gameSettings: TUDKIniFile;
  engineSettings: TUDKIniFile;
  mapListValues: TStringList;
  mapName: string;
  mapListChanged: Boolean;

begin
  gameSettings := TUDKIniFile.Create(Location + GameSettingsFileName);
  try
    SetServerPort(gameSettings.ReadInteger(GameURL, GameURLPort, GameURLPortDefault));
    SetPeerPort(gameSettings.ReadInteger(GameURL, GameURLPeerPort, GameURLPeerPortDefault));

    SetServerName(gameSettings.ReadString(GameReplicationInfo, GameReplicationInfoServerName, ''));
    SetMessageOfTheDay(gameSettings.ReadString(GameReplicationInfo, GameReplicationInfoMessageOfTheDay, ''));

    mapListChanged := (FMapList.Count > 0);
    FMapList.Clear;

    { Maplist is special; it occurs multiple times and order matters }
    mapListValues := TStringList.Create;
    try
      gameSettings.ReadDuplicateStrings(GameAOCGame, GameAOCGameMapList, mapListValues);
      for mapName in mapListValues do
      begin
        FMapList.Add(CreateGameMap(mapName));
        mapListChanged := True;
      end;
    finally
      FreeAndNil(mapListValues);
    end;

    if mapListChanged then
      PropertyChanged('MapList');
  finally
    FreeAndNil(gameSettings);
  end;

  engineSettings := TUDKIniFile.Create(Location + EngineSettingsFileName);
  try
    SetQueryPort(engineSettings.ReadInteger(EngineSteam, EngineSteamQueryPort, EngineSteamQueryPortDefault));
  finally
    FreeAndNil(engineSettings);
  end;
end;


procedure TChivalryGame.DoSave;
var
  gameSettings: TUDKIniFile;
  engineSettings: TUDKIniFile;
  map: TGameMap;

begin
  gameSettings := TUDKIniFile.Create(Location + GameSettingsFileName);
  try
    gameSettings.WriteInteger(GameURL, GameURLPort, ServerPort);
    gameSettings.WriteInteger(GameURL, GameURLPeerPort, PeerPort);

    gameSettings.WriteString(GameReplicationInfo, GameReplicationInfoServerName, ServerName);
    gameSettings.WriteString(GameReplicationInfo, GameReplicationInfoMessageOfTheDay, MessageOfTheDay);

    { Remove all Maplist references before rewriting the list }
    gameSettings.DeleteDuplicateKeys(GameAOCGame, GameAOCGameMapList);

    for map in MapList do
      gameSettings.WriteDuplicateString(GameAOCGame, GameAOCGameMapList, map.Name);

    gameSettings.UpdateFile;
  finally
    FreeAndNil(gameSettings);
  end;

  engineSettings := TUDKIniFile.Create(Location + EngineSettingsFileName);
  try
    engineSettings.WriteInteger(EngineSteam, EngineSteamQueryPort, QueryPort);

    engineSettings.UpdateFile;
  finally
    FreeAndNil(engineSettings);
  end;
end;


function TChivalryGame.CreateGameMap(const AMapName: string): TGameMap;
var
  map: TGameMap;

begin
  Result := nil;

  for map in PredefinedMapList do
    if SameText(map.Name, AMapName) then
    begin
      Result := TGameMap.Create(map);
      break;
    end;


  if not Assigned(Result) then
    Result := TGameMap.Create(AMapName, '', '');
end;


function TChivalryGame.GetServerPort: Integer;
begin
  Result := FServerPort;
end;


function TChivalryGame.GetPeerPort: Integer;
begin
  Result := FPeerPort;
end;


function TChivalryGame.GetQueryPort: Integer;
begin
  Result := FQueryPort;
end;


procedure TChivalryGame.SetServerPort(const Value: Integer);
begin
  if Value <> FServerPort then
  begin
    FServerPort := Value;
    PropertyChanged('ServerPort');
  end;
end;


procedure TChivalryGame.SetPeerPort(const Value: Integer);
begin
  if Value <> FPeerPort then
  begin
    FPeerPort := Value;
    PropertyChanged('PeerPort');
  end;
end;


procedure TChivalryGame.SetQueryPort(const Value: Integer);
begin
  if Value <> FQueryPort then
  begin
    FQueryPort := Value;
    PropertyChanged('QueryPort');
  end;
end;


function TChivalryGame.GetServerName: string;
begin
  Result := FServerName;
end;


function TChivalryGame.GetMessageOfTheDay: string;
begin
  Result := FMessageOfTheDay;
end;


procedure TChivalryGame.SetServerName(const Value: string);
begin
  if Value <> FServerName then
  begin
    FServerName := Value;
    PropertyChanged('ServerName');
  end;
end;


procedure TChivalryGame.SetMessageOfTheDay(const Value: string);
begin
  if Value <> FMessageOfTheDay then
  begin
    FMessageOfTheDay := Value;
    PropertyChanged('MessageOfTheDay');
  end;
end;


function TChivalryGame.GetPredefinedMapList: TEnumerable<TGameMap>;
begin
  Result := FPredefinedMapList;
end;


function TChivalryGame.GetMapList: TEnumerable<TGameMap>;
begin
  Result := FMapList;
end;


function TChivalryGame.GetMapCount: Integer;
begin
  Result := FMapList.Count;
end;


function TChivalryGame.GetMap(Index: Integer): TGameMap;
begin
  Result := FMapList[Index];
end;


procedure TChivalryGame.AddMap(AMap: TGameMap);
begin
  FMapList.Add(AMap);
  PropertyChanged('MapList');
end;


procedure TChivalryGame.InsertMap(Index: Integer; AMap: TGameMap);
begin
  FMapList.Insert(Index, AMap);
  PropertyChanged('MapList');
end;


procedure TChivalryGame.DeleteMap(AIndex: Integer);
begin
  FMapList.Delete(AIndex);
  PropertyChanged('MapList');
end;


procedure TChivalryGame.RemoveMap(AMap: TGameMap);
begin
  if FMapList.Remove(AMap) > -1 then
    PropertyChanged('MapList');
end;


procedure TChivalryGame.MoveMap(ASourceIndex, ATargetIndex: Integer);
begin
  if ATargetIndex <> ASourceIndex then
  begin
    FMapList.Move(ASourceIndex, ATargetIndex);
    PropertyChanged('MapList');
  end;
end;

end.