source: trunk/GameSystem.pas

unit GameSystem;

interface

uses
  Classes, SysUtils, Generics.Collections, DOM, XMLRead, XMLWrite, XML,
  XMLConf, FileUtil, LazFileUtils, MapType, Nation, Building, ItemList, UnitKind;

type
  TActionExecutionPhase = (epEndOfTurn, epInstantly);

  { TGameSystem }

  TGameSystem = class
    FileName: string;
    MaxPlayerCount: Integer;
    UnitKinds: TUnitKinds;
    UnitsSplitMerge: Boolean;
    EmptyCellsNeutral: Boolean;
    UnitsMoveImmediately: Boolean;
    PreferedMapType: TMapType;
    Nations: TNations;
    BuildingKinds: TBuildingKinds;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function GetName: string;
    procedure Assign(Source: TGameSystem);
    function Compare(GameSystem: TGameSystem): Boolean;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromFile(FileName: string);
    procedure SaveToFile(FileName: string);
    procedure LoadConfig(Config: TXmlConfig; Path: string);
    procedure SaveConfig(Config: TXmlConfig; Path: string);
  end;

  { TGameSystems }

  TGameSystems = class(TObjectList<TGameSystem>)
    function AddNew(Name: string): TGameSystem;
    function SearchByName(Name: string): TGameSystem;
    procedure LoadFromDir(Dir: string);
  end;

const
  GameSystemExt = '.xts';

resourcestring
  SGameSystem = 'Game system';


implementation

resourcestring
  SWrongFileFormat = 'Wrong file format';

{ TGameSystems }

function TGameSystems.AddNew(Name: string): TGameSystem;
begin
  Result := TGameSystem.Create;
  Result.FileName := Name;
  Add(Result);
end;

function TGameSystems.SearchByName(Name: string): TGameSystem;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].GetName <> Name) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

procedure TGameSystems.LoadFromDir(Dir: string);
var
  Files: TStringList;
  I: Integer;
  NewItem: TGameSystem;
begin
  Files := TStringList.Create;
  try
    FindAllFiles(Files, Dir, '*' + GameSystemExt, True, faAnyFile);
    for I := 0 to Files.Count - 1 do begin
      NewItem := TGameSystem.Create;
      NewItem.LoadFromFile(Files[I]);
      Add(NewItem);
    end;
  finally
    Files.Free;
  end;
end;

{ TGameSystem }

constructor TGameSystem.Create;
begin
  UnitKinds := TUnitKinds.Create;
  BuildingKinds := TBuildingKinds.Create;
  Nations := TNations.Create;
end;

destructor TGameSystem.Destroy;
begin
  FreeAndNil(Nations);
  FreeAndNil(BuildingKinds);
  FreeAndNil(UnitKinds);
  inherited;
end;

procedure TGameSystem.Clear;
begin
  UnitKinds.Clear;
  BuildingKinds.Clear;
  Nations.Clear;
end;

function TGameSystem.GetName: string;
begin
  Result := ExtractFileNameWithoutExt(ExtractFileName(FileName));
end;

procedure TGameSystem.Assign(Source: TGameSystem);
begin
  FileName := Source.FileName;
  UnitsMoveImmediately := Source.UnitsMoveImmediately;
  MaxPlayerCount := Source.MaxPlayerCount;
  UnitsSplitMerge := Source.UnitsSplitMerge;
  EmptyCellsNeutral := Source.EmptyCellsNeutral;
  PreferedMapType := Source.PreferedMapType;
  UnitKinds.Assign(Source.UnitKinds);
  BuildingKinds.Assign(Source.BuildingKinds);
  Nations.Assign(Source.Nations);
end;

function TGameSystem.Compare(GameSystem: TGameSystem): Boolean;
begin
  Result := (FileName = GameSystem.FileName) and
    (UnitsMoveImmediately = GameSystem.UnitsMoveImmediately) and
    (MaxPlayerCount = GameSystem.MaxPlayerCount) and
    (UnitsSplitMerge = GameSystem.UnitsSplitMerge) and
    (EmptyCellsNeutral = GameSystem.EmptyCellsNeutral) and
    (PreferedMapType = GameSystem.PreferedMapType) and
    UnitKinds.Compare(GameSystem.UnitKinds) and
    BuildingKinds.Compare(GameSystem.BuildingKinds) and
    Nations.Compare(GameSystem.Nations);
end;

procedure TGameSystem.LoadFromNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  UnitsSplitMerge := ReadBoolean(Node, 'UnitsSplitMerge', False);
  EmptyCellsNeutral := ReadBoolean(Node, 'EmptyCellsNeutral', False);
  UnitsMoveImmediately := ReadBoolean(Node, 'UnitsMoveImmediately', False);
  PreferedMapType := TMapType(ReadInteger(Node, 'PreferedMapType', Integer(mtNone)));

  NewNode := Node.FindNode('UnitKinds');
  if Assigned(NewNode) then
    UnitKinds.LoadFromNode(NewNode);
  NewNode := Node.FindNode('BuildingKinds');
  if Assigned(NewNode) then
    BuildingKinds.LoadFromNode(NewNode);
  NewNode := Node.FindNode('Nations');
  if Assigned(NewNode) then
    Nations.LoadFromNode(NewNode);
end;

procedure TGameSystem.SaveToNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  WriteBoolean(Node, 'UnitsSplitMerge', UnitsSplitMerge);
  WriteBoolean(Node, 'EmptyCellsNeutral', EmptyCellsNeutral);
  WriteBoolean(Node, 'UnitsMoveImmediately', UnitsMoveImmediately);
  WriteInteger(Node, 'PreferedMapType', Integer(PreferedMapType));

  NewNode := Node.OwnerDocument.CreateElement('UnitKinds');
  Node.AppendChild(NewNode);
  UnitKinds.SaveToNode(NewNode);
  NewNode := Node.OwnerDocument.CreateElement('BuildingKinds');
  Node.AppendChild(NewNode);
  BuildingKinds.SaveToNode(NewNode);
  NewNode := Node.OwnerDocument.CreateElement('Nations');
  Node.AppendChild(NewNode);
  Nations.SaveToNode(NewNode);
end;

procedure TGameSystem.LoadFromFile(FileName: string);
var
  Doc: TXMLDocument;
  RootNode: TDOMNode;
begin
  ReadXMLFile(Doc, FileName);
  Self.FileName := FileName;
  Clear;
  with Doc do try
    if Doc.DocumentElement.NodeName <> 'XtacticsGameSystem' then
      raise Exception.Create(SWrongFileFormat);
    RootNode := Doc.DocumentElement;
    LoadFromNode(RootNode);
  finally
    FreeAndNil(Doc);
  end;
end;

procedure TGameSystem.SaveToFile(FileName: string);
var
  Doc: TXMLDocument;
  RootNode: TDOMNode;
begin
  Self.FileName := FileName;
  Doc := TXMLDocument.Create;
  with Doc do try
    RootNode := CreateElement('XtacticsGameSystem');
    AppendChild(RootNode);
    SaveToNode(RootNode);
    if ExtractFileDir(FileName) <> '' then
      ForceDirectories(ExtractFileDir(FileName));
    WriteXMLFile(Doc, FileName);
  finally
    FreeAndNil(Doc);
  end;
end;

procedure TGameSystem.LoadConfig(Config: TXmlConfig; Path: string);
begin
  with Config do begin
    UnitsSplitMerge := GetValue(DOMString(Path + '/UnitsSplitMerge'), True);
    EmptyCellsNeutral := GetValue(DOMString(Path + '/EmptyCellsNeutral'), False);
    UnitsMoveImmediately := GetValue(DOMString(Path + '/UnitsMoveImmediately'), False);
    PreferedMapType := TMapType(GetValue(DOMString(Path + '/PreferedMapType'), Integer(mtNone)));
  end;
end;

procedure TGameSystem.SaveConfig(Config: TXmlConfig; Path: string);
begin
  with Config do begin
    SetValue(DOMString(Path + '/UnitsSplitMerge'), UnitsSplitMerge);
    SetValue(DOMString(Path + '/EmptyCellsNeutral'), EmptyCellsNeutral);
    SetValue(DOMString(Path + '/UnitsMoveImmediately'), UnitsMoveImmediately);
    SetValue(DOMString(Path + '/PreferedMapType'), Integer(PreferedMapType));
  end;
end;

end.